home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
COMPILER
/
VP10B003
/
VPC
/
SOURCE
/
TV
/
TV4VP.PAT
< prev
next >
Wrap
Text File
|
1995-06-21
|
167KB
|
4,772 lines
Comparing BP7\OBJECTS.PAS and VP\OBJECTS.PAS
10a11,12
> { NOTE: TEmsStream is not implemented. }
>
13c15
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,B-,Cdecl-}
16a19,20
> uses Use32;
>
38c42
< MaxCollectionSize = 65520 div SizeOf(Pointer);
> MaxCollectionSize = 512*1024*1024 div SizeOf(Pointer);
47c51
< vmtHeaderSize = 8;
> vmtHeaderSize = 12;
58c62
< Lo, Hi: Word;
> Lo, Hi: SmallWord;
62c66
< Ofs, Seg: Word;
> Ofs: Longint;
77c81
< TByteArray = array[0..32767] of Byte;
> TByteArray = array[0..512*1024*1024] of Byte;
80c84,87
< TWordArray = array[0..16383] of Word;
> TWordArray = array[0..512*1024*1024 div 2] of SmallWord;
>
> PLongArray = ^TLongArray;
> TLongArray = array[0..512*1024*1024 div 4] of Longint;
81a89,91
> PPtrArray = ^TPtrArray;
> TPtrArray = array[0..512*1024*1024 div 4] of Pointer;
>
99c109
< Next: Word;
> Next: PStreamRec;
129,133c139
< {$IFDEF Windows}
> FNameStr = String;
158c164
< constructor Init(FileName: FNameStr; Mode, Size: Word);
> constructor Init(const FileName: FNameStr; Mode, Size: Word);
169,186d174
< { TEmsStream }
191,193c179,181
< SegCount: Integer;
> BlockCount: Integer;
> BlockList: PPtrArray;
> CurBlock: Integer;
283,284d270
< {$IFNDEF Windows}
378,379d363
< {$ENDIF}
385,392d368
< { Longint routines }
404a381,384
> { Analog to DOS int 21h I/O functions }
>
> procedure DosFn;
>
411,415d390
< { EMS stream state variables }
439,440d413
< {$IFNDEF Windows }
455,456d427
< {$ENDIF}
459,471c430
< {$IFDEF Windows}
> uses Memory, Strings, Os2Base;
487d445
< {$IFNDEF Windows}
489d446
< {$ENDIF}
506c463
< StreamTypes: Word = 0;
> StreamTypes: PStreamRec = nil;
513,531c470,478
< procedure RegisterType(var S: TStreamRec); assembler;
> procedure RegisterType(var S: TStreamRec);
> var
> P: PStreamRec;
> begin
> P := StreamTypes;
> while (P <> nil) and (P^.ObjType <> S.ObjType) do P := P^.Next;
> if (P <> nil) or (S.ObjType = 0) then RegisterError;
> S.Next := StreamTypes;
> StreamTypes := @S;
543,559c490,502
< { In AX = Error info }
> { In eax = Error info }
> { dl = Error code }
> { ecx = Stream object pointer }
> { Uses eax,edx }
>
> procedure DoStreamError; assembler; {$USES ecx} {$FRAME-}
> asm
> movsx edx,dl
> push edx { [1]:Integer = Code }
> push eax { [2]:Integer = Info }
> push ecx { [3]:Pointer = Self }
> mov eax,[ecx]
> Call DWord Ptr [eax].TStream_Error
598c541
< function TStream.Get: PObject; assembler;
> function TStream.Get: PObject; assembler; {$USES None} {$FRAME+}
600,635c543,573
< PUSH AX
> push eax
> mov eax,esp
> push eax { [1]:Pointer = Buf }
> push 4 { [2]:DWord = Count }
> mov eax,Self
> push eax { [3]:Pointer = Self }
> mov eax,[eax]
> Call DWord Ptr [eax].TStream_Read
> pop eax
> test eax,eax { Return nil }
> jz @@4
> mov edx,StreamTypes
> jmp @@2
> @@1:
> cmp eax,[edx].TStreamRec.ObjType
> je @@3
> mov edx,[edx].TStreamRec.Next
> @@2:
> test edx,edx
> jnz @@1
> mov ecx,Self
> mov dl,stGetError
> Call DoStreamError
> xor eax,eax { Return nil }
> jmp @@4
> @@3:
> push Self { [1]:Pointer = TStream }
> push [edx].TStreamRec.VmtLink{ [2]:DWord = VMT }
> push 0 { [3]:Pointer = Self = nil: allocate in dynamic memory }
> Call [edx].TStreamRec.Load
> @@4: { Return Self or nil }
648c586
< procedure TStream.Put(P: PObject); assembler;
> procedure TStream.Put(P: PObject); assembler; {$USES None} {$FRAME+}
650,688c588,622
< LES DI,P
> mov ecx,P
> jecxz @@4
> mov eax,[ecx] { VMT pointer }
> mov edx,StreamTypes
> jmp @@2
> @@1:
> cmp eax,[edx].TStreamRec.VmtLink
> je @@3
> mov edx,[edx].TStreamRec.Next
> @@2:
> test edx,edx
> jne @@1
> mov ecx,Self
> mov dl,stPutError
> Call DoStreamError
> jmp @@5
> @@3:
> mov ecx,[edx].TStreamRec.ObjType
> @@4:
> push edx
> push ecx { Write object type }
> mov eax,esp
> push eax { [1]:Pointer = Buf }
> push 4 { [2]:DWord = Size }
> mov eax,Self { [3]:Pointer = Self }
> push eax
> mov eax,[eax]
> Call DWord Ptr [eax].TStream_Write
> pop ecx
> pop edx
> jecxz @@5
> push Self { [1]:Pointer = TStream }
> push P { [2]:Pointer = Self }
> Call [edx].TStreamRec.Store
> @@5:
764a699,700
> {$USES ebx,esi,edi} {$FRAME+}
>
769,972c705,877
< XOR AX,AX
> push 0 { [1]:DWord = VMT }
> push Self { [2]:Pointer = Self }
> Call TStream.Init { Inherited Init; }
> mov esi,FileName
> lea edi,NameBuf
> mov edx,edi { edx = @FName (ASCIIZ) }
> xor eax,eax
> cld
> lodsb
> cmp al,79
> jb @@1
> mov al,79
> @@1:
> xchg ecx,eax
> rep movsb { File name }
> xchg eax,ecx
> stosb { Null terminator }
> xor ecx,ecx { ecx = File attribute }
> mov eax,Mode { ah=DosFn,al=Open mode }
> Call DosFn
> jnc @@2 { eax = File Handle }
> mov ecx,Self
> mov dl,stInitError
> Call DoStreamError
> or eax,-1
> @@2:
> mov ecx,Self
> mov [ecx].TDosStream.Handle,eax
> end;
>
> destructor TDosStream.Done; assembler; {$USES ebx} {$FRAME+}
> asm
> mov eax,Self
> mov ebx,[eax].TDosStream.Handle
> cmp ebx,-1
> je @@1
> mov ah,3Eh { Close file }
> Call DosFn
> @@1:
> push 0 { [1]:DWord = VMT }
> push Self { [2]:Pointer = Self }
> Call TStream.Done { Inherited Done; }
> end;
>
> function TDosStream.GetPos: Longint; assembler; {$USES ebx} {$FRAME-}
> asm
> mov eax,Self
> cmp [eax].TDosStream.Status,stOk
> jne @@1
> xor ecx,ecx { ecx = Distance }
> mov ebx,[eax].TDosStream.Handle { ebx = File Handle }
> mov ax,4201h { Get current position }
> Call DosFn
> jnc @@2
> mov ecx,Self
> mov dl,stError
> Call DoStreamError { eax = Current FilePtr }
> @@1:
> or eax,-1
> @@2:
> end;
>
> function TDosStream.GetSize: Longint; assembler; {$USES ebx} {$FRAME-}
> asm
> mov eax,Self
> cmp [eax].TDosStream.Status,stOk
> jne @@1
> xor ecx,ecx { ecx = Distance }
> mov ebx,[eax].TDosStream.Handle
> mov ax,4201h { ebx = Handle }
> Call DosFn
> push eax { Save current position }
> xor ecx,ecx
> mov ax,4202h { Move to the EOF }
> Call DosFn
> pop ecx
> push eax
> mov ax,4200h { Restore old position }
> Call DosFn
> pop eax
> jnc @@2
> mov ecx,Self
> mov dl,stError
> Call DoStreamError
> @@1:
> or eax,-1
> @@2:
> end;
>
> procedure TDosStream.Read(var Buf; Count: Word); assembler; {$USES ebx,edi} {$FRAME-}
> asm
> mov edi,Self
> cmp [edi].TDosStream.Status,stOk
> jne @@2
> mov edx,Buf { edx = Buffer@ }
> mov ecx,Count { ecx = Count }
> mov ebx,[edi].TDosStream.Handle { ebx = File Handle }
> mov ah,3Fh { Read file }
> Call DosFn
> mov dl,stError
> jc @@1
> cmp eax,ecx
> je @@3
> xor eax,eax
> mov dl,stReadError
> @@1:
> mov ecx,edi
> Call DoStreamError
> @@2:
> mov edi,Buf
> mov ecx,Count
> xor al,al
> cld
> rep stosb
> @@3:
> end;
>
> procedure TDosStream.Seek(Pos: Longint); assembler; {$USES ebx} {$FRAME-}
> asm
> mov eax,Self
> cmp [eax].TDosStream.Status,stOk
> jne @@2
> mov ecx,Pos
> test ecx,ecx
> jns @@1
> xor ecx,ecx
> @@1:
> mov ebx,[eax].TDosStream.Handle
> mov ax,4200h
> Call DosFn
> jnc @@2
> mov ecx,Self
> mov dl,stError
> Call DoStreamError
> @@2:
> end;
>
> procedure TDosStream.Truncate; assembler; {$USES ebx} {$FRAME-}
> asm
> mov eax,Self
> cmp [eax].TDosStream.Status,stOk
> jne @@1
> xor ecx,ecx { ecx=0: Truncate file }
> mov ebx,[eax].TDosStream.Handle
> mov ah,40h { Write file }
> Call DosFn
> jnc @@1
> mov ecx,Self
> mov dl,stError
> Call DoStreamError
> @@1:
> end;
>
> procedure TDosStream.Write(var Buf; Count: Word); assembler; {$USES ebx} {$FRAME-}
> asm
> mov eax,Self
> cmp [eax].TDosStream.Status,stOk
> jne @@2
> mov edx,Buf
> mov ecx,Count
> mov ebx,[eax].TDosStream.Handle
> mov ah,40h
> Call DosFn
> mov dl,stError
> jc @@1
> cmp eax,ecx
> je @@2
> xor eax,eax
> mov dl,stWriteError
> @@1:
> mov ecx,Self
> Call DoStreamError
> @@2:
979c884
< { ES:DI = TBufStream pointer }
> { edi = TBufStream pointer }
982c887
< procedure FlushBuffer; near; assembler;
> procedure FlushBuffer; assembler; {$USES ebx} {$FRAME-}
984,1014c889,919
< MOV CX,ES:[DI].TBufStream.BufPtr
> mov ecx,[edi].TBufStream.BufPtr
> sub ecx,[edi].TBufStream.BufEnd
> je @@3
> mov ebx,[edi].TDosStream.Handle
> ja @@1
> cmp al,1
> je @@4
> mov ax,4201h { Seek from current position }
> Call DosFn
> jmp @@3
> @@1:
> cmp al,0
> je @@4
> mov edx,[edi].TBufStream.Buffer
> mov ah,40h
> Call DosFn
> mov dl,stError
> jc @@2
> cmp eax,ecx
> je @@3
> xor eax,eax
> mov dl,stWriteError
> @@2:
> mov ecx,edi
> Call DoStreamError
> @@3:
> xor eax,eax
> mov [edi].TBufStream.BufPtr,eax
> mov [edi].TBufStream.BufEnd,eax
> cmp [edi].TStream.Status,stOk
> @@4:
1017c922
< constructor TBufStream.Init(FileName: FNameStr; Mode, Size: Word);
> constructor TBufStream.Init(const FileName: FNameStr; Mode, Size: Word);
1034c939
< procedure TBufStream.Flush; assembler;
> procedure TBufStream.Flush; assembler; {$USES edi} {$FRAME-}
1036,1155c941,1052
< LES DI,Self
> mov edi,Self
> cmp [edi].TBufStream.Status,stOk
> jne @@1
> mov al,2 { Read/Write mode }
> Call FlushBuffer
> @@1:
> end;
>
> function TBufStream.GetPos: Longint; assembler; {$USES edi} {$FRAME-}
> asm
> mov edi,Self
> push edi
> Call TDosStream.GetPos
> test eax,eax
> js @@1
> sub eax,[edi].TBufStream.BufEnd
> add eax,[edi].TBufStream.BufPtr
> @@1:
> end;
>
> function TBufStream.GetSize: Longint; assembler; {$USES None} {$FRAME-}
> asm
> mov eax,Self
> push eax
> push eax
> Call TBufStream.Flush
> Call TDosStream.GetSize
> end;
>
> procedure TBufStream.Read(var Buf; Count: Word); assembler; {$USES ebx,esi,edi} {$FRAME-}
> asm
> mov edi,Self
> cmp [edi].TBufStream.Status,stOk
> jne @@6
> mov al,1 { Write mode }
> Call FlushBuffer
> jne @@6
> xor ebx,ebx
> @@1:
> mov ecx,Count
> sub ecx,ebx
> je @@7
> mov edi,Self
> mov eax,[edi].TBufStream.BufEnd
> sub eax,[edi].TBufStream.BufPtr
> ja @@2
> push ecx
> push ebx
> mov edx,[edi].TBufStream.Buffer
> mov ecx,[edi].TBufStream.BufSize
> mov ebx,[edi].TBufStream.Handle
> mov ah,3Fh
> Call DosFn
> pop ebx
> pop ecx
> mov dl,stError
> jc @@5
> and [edi].TBufStream.BufPtr,0
> mov [edi].TBufStream.BufEnd,eax
> test eax,eax
> je @@4
> @@2:
> cmp ecx,eax
> jb @@3
> mov ecx,eax
> @@3:
> mov esi,[edi].TBufStream.Buffer
> add esi,[edi].TBufStream.BufPtr
> add [edi].TBufStream.BufPtr,ecx
> mov edi,Buf
> add edi,ebx
> add ebx,ecx
> cld
> rep movsb
> jmp @@1
> @@4:
> mov dl,stReadError
> @@5:
> mov ecx,edi
> Call DoStreamError
> @@6:
> mov edi,Buf
> mov ecx,Count
> xor al,al
> cld
> rep stosb
> @@7:
> end;
>
> procedure TBufStream.Seek(Pos: Longint); assembler; {$USES edi} {$FRAME-}
> asm
> mov edi,Self
> push edi
> Call TDosStream.GetPos
> test eax,eax
> js @@2
> sub eax,Pos
> jne @@1
> test eax,eax
> je @@1
> mov edx,[edi].TBufStream.BufEnd
> sub edx,eax
> jb @@1
> mov [edi].TBufStream.BufPtr,edx
> jmp @@2
> @@1:
> push edi
> Call TBufStream.Flush
> push Pos
> push edi
> Call TDosStream.Seek
> @@2:
1164,1261c1061
< procedure TBufStream.Write(var Buf; Count: Word); assembler;
> procedure TBufStream.Write(var Buf; Count: Word); assembler; {$USES esi,edi} {$FRAME-}
1263,1517c1063,1101
< XOR AX,AX
> mov edi,Self
> cmp [edi].TBufStream.Status,stOk
> jne @@4
> mov al,0 { Read mode }
> Call FlushBuffer
> jne @@4
> xor edx,edx
> @@1:
> mov ecx,Count
> sub ecx,edx
> je @@4
> mov edi,Self
> mov eax,[edi].TBufStream.BufSize
> sub eax,[edi].TBufStream.BufPtr
> ja @@2
> push ecx
> push edx
> mov al,1 { Write mode }
> Call FlushBuffer
> pop edx
> pop ecx
> jne @@4
> mov eax,[edi].TBufStream.BufSize
> @@2:
> cmp ecx,eax
> jb @@3
> mov ecx,eax
> @@3:
> mov eax,[edi].TBufStream.BufPtr
> add [edi].TBufStream.BufPtr,ecx
> mov edi,[edi].TBufStream.Buffer
> add edi,eax
> mov esi,Buf
> add esi,edx
> add edx,ecx
> cld
> rep movsb
> jmp @@1
> @@4:
1523,1527c1107,1108
< MaxSegArraySize = 16384;
> MaxBlockArraySize = 512 * 1024 * 1024 div 4;
> DefaultBlockSize = 8 * 1024;
1529,1544c1110,1124
< {$ELSE}
> { Selects TMemoryStream memory block }
> { In edi = TMemoryStream pointer }
> { Out ecx = Distance between position and end of block }
> { esi = Position within the selected block }
>
> procedure MemSelectBlock; assembler; {$USES None} {$FRAME-}
> asm
> mov eax,[edi].TMemoryStream.Position
> xor edx,edx
> mov ecx,[edi].TMemoryStream.BlockSize
> div ecx
> sub ecx,edx
> mov esi,edx
> shl eax,2
> mov [edi].TMemoryStream.CurBlock,eax
1550c1130
< constructor TMemoryStream.Init(ALimit: Longint; ABlockSize: Word); assembler;
> constructor TMemoryStream.Init(ALimit: Longint; ABlockSize: Word); assembler; {$USES edi} {$FRAME+}
1552,1591c1132,1158
< XOR AX,AX
> push 0
> push Self
> Call TStream.Init
> mov edi,Self
> cmp ABlockSize,0
> jnz @@1
> mov ABlockSize,DefaultBlockSize
> @@1:
> mov ecx,ABlockSize
> mov eax,ALimit
> xor edx,edx
> div ecx
> neg edx
> adc eax,0
> mov [edi].TMemoryStream.BlockSize,ecx
> push eax { [1]:DWord = ALimit }
> push edi { [2]:Pointer = Self }
> Call ChangeListSize
> test al,al
> jnz @@2
> mov dl,stInitError
> mov ecx,edi
> Call DoStreamError
> and ALimit,0
> @@2:
> mov eax,ALimit
> mov [edi].TMemoryStream.Size,eax
1602c1169
< AItems: PWordArray;
> AItems: PPtrArray;
1607,1608c1174,1175
< if ALimit > MaxSegArraySize then ALimit := MaxSegArraySize;
> if ALimit > MaxBlockArraySize then ALimit := MaxBlockArraySize;
> if ALimit <> BlockCount then
1612c1179
< AItems := MemAlloc(ALimit * SizeOf(Word));
> AItems := MemAlloc(ALimit * SizeOf(Pointer));
1614,1617c1181,1184
< FillChar(AItems^, ALimit * SizeOf(Word), 0);
> FillChar(AItems^, ALimit * SizeOf(Pointer), 0);
> if (BlockCount <> 0) and (BlockList <> nil) then
> if BlockCount > ALimit then
> Move(BlockList^, AItems^, ALimit * SizeOf(Pointer))
1619c1186
< Move(SegList^, AItems^, SegCount * SizeOf(Word));
> Move(BlockList^, AItems^, BlockCount * SizeOf(Pointer));
1621c1188
< if ALimit < SegCount then
> if ALimit < BlockCount then
1624c1191
< Term := SegCount - 1;
> Term := BlockCount - 1;
1627,1628c1194,1195
< if SegList^[Dif] <> 0 then
> if BlockList^[Dif] <> nil then
> FreeMem(BlockList^[Dif], BlockSize);
1634c1201
< Dif := SegCount;
> Dif := BlockCount;
1638c1205
< NewBlock := MemAllocSeg(BlockSize);
> NewBlock := MemAlloc(BlockSize);
1640c1207
< else AItems^[Dif] := PtrRec(NewBlock).Seg;
> else AItems^[Dif] := NewBlock;
1646,1648c1213,1215
< if SegCount <> 0 then FreeMem(SegList, SegCount * SizeOf(Word));
> if BlockCount <> 0 then FreeMem(BlockList, BlockCount * SizeOf(Pointer));
> BlockList := AItems;
> BlockCount := ALimit;
1652,1836c1219,1369
< function TMemoryStream.GetPos: Longint; assembler;
> function TMemoryStream.GetPos: Longint;
> begin
> if Status = stOk then GetPos := Position else GetPos := -1;
> end;
>
> function TMemoryStream.GetSize: Longint;
> begin
> if Status = stOk then GetSize := Size else GetSize := -1;
> end;
>
> procedure TMemoryStream.Read(var Buf; Count: Word); assembler; {$USES ebx,esi,edi} {$FRAME+}
> asm
> mov edi,Self
> cmp [edi].TMemoryStream.Status,stOk
> jne @@3
> xor ebx,ebx
> mov eax,[edi].TMemoryStream.Position
> add eax,Count
> cmp eax,[edi].TMemoryStream.Size
> jbe @@7
> xor eax,eax
> mov ecx,edi
> mov dl,stReadError
> Call DoStreamError
> @@3:
> mov edi,Buf
> mov ecx,Count
> xor al,al
> cld
> rep stosb
> jmp @@8
> @@5:
> Call MemSelectBlock
> mov eax,Count
> sub eax,ebx
> cmp ecx,eax
> jb @@6
> mov ecx,eax
> @@6:
> add [edi].TMemoryStream.Position,ecx
> push edi
> mov edx,[edi].TMemoryStream.CurBlock
> mov eax,[edi].TMemoryStream.BlockList
> add esi,[eax+edx] { Block base pointer }
> mov edi,Buf
> add edi,ebx
> add ebx,ecx
> mov al,cl
> shr ecx,2
> and al,11b
> cld
> rep movsd
> mov cl,al
> rep movsb
> pop edi
> @@7:
> cmp ebx,Count
> jb @@5
> @@8:
> end;
>
> procedure TMemoryStream.Seek(Pos: Longint);
> begin
> if Status = stOk then
> if Pos > 0 then Position := Pos else Position := 0;
> end;
>
> procedure TMemoryStream.Truncate; assembler; {$USES None} {$FRAME-}
> asm
> mov ecx,Self
> cmp [ecx].TMemoryStream.Status,stOk
> jne @@2
> mov eax,[ecx].TMemoryStream.Position
> xor edx,edx
> div [ecx].TMemoryStream.BlockSize
> neg edx
> adc eax,0
> push eax { [1]:DWord = ALimit }
> push ecx { [2]:Pointer = Self }
> Call ChangeListSize
> mov ecx,Self
> test al,al
> jnz @@1
> mov dl,stError
> Call DoStreamError
> jmp @@2
> @@1:
> mov eax,[ecx].TMemoryStream.Position
> mov [ecx].TMemoryStream.Size,eax
> @@2:
> end;
>
> procedure TMemoryStream.Write(var Buf; Count: Word); assembler; {$USES ebx,esi,edi} {$FRAME+}
> asm
> mov edi,Self
> cmp [edi].TMemoryStream.Status,stOk
> jne @@7
> xor ebx,ebx
> mov eax,[edi].TMemoryStream.Position
> add eax,Count
> xor edx,edx
> div [edi].TMemoryStream.BlockSize
> neg edx
> adc eax,0
> cmp eax,[edi].TMemoryStream.BlockCount
> jbe @@4
> push eax { [1]:DWord = ALimit }
> push edi { [2]:Pointer = Self }
> Call ChangeListSize
> test al,al
> jnz @@4
> @@1:
> mov ecx,edi
> mov dl,stWriteError
> Call DoStreamError
> jmp @@7
> @@2:
> Call MemSelectBlock
> mov eax,Count
> sub eax,ebx
> cmp ecx,eax
> jb @@3
> mov ecx,eax
> @@3:
> add [edi].TMemoryStream.Position,ecx
> push edi
> mov edx,[edi].TMemoryStream.CurBlock
> mov eax,[edi].TMemoryStream.BlockList
> add esi,[eax+edx]
> mov edi,esi
> mov esi,Buf
> add esi,ebx
> add ebx,ecx
> mov al,cl
> shr ecx,2
> and al,11b
> cld
> rep movsd
> mov cl,al
> rep movsb
> pop edi
> @@4:
> cmp ebx,Count
> jb @@2
> @@5:
> mov eax,[edi].TMemoryStream.Position
> cmp eax,[edi].TMemoryStream.Size
> jbe @@7
> @@6:
> mov [edi].TMemoryStream.Size,eax
> @@7:
1845,1852c1378,1390
< procedure CollectionError; near; assembler;
> { Reports collection error }
> { In al = Error code }
> { edx = Error info }
> { edi = TCollection pointer }
>
> procedure CollectionError; assembler; {$USES None} {$FRAME-}
> asm
> movsx eax,al
> push eax { [1]:DWord = Error code }
> push edx { [2]:DWord = Error info }
> push edi { [3]:Pointer = Self }
> mov eax,[edi]
> Call DWord Ptr [eax].TCollection_Error
1886c1424
< function TCollection.At(Index: Integer): Pointer; assembler;
> function TCollection.At(Index: Integer): Pointer; assembler; {$USES edi} {$FRAME-}
1888,1934c1426,1463
< LES DI,Self
> mov edi,Self
> mov edx,Index
> test edx,edx
> jl @@1
> cmp edx,[edi].TCollection.Count
> jge @@1
> mov edi,[edi].TCollection.Items
> mov eax,[edi+edx*4]
> jmp @@2
> @@1:
> mov al,coIndexError
> Call CollectionError
> xor eax,eax
> @@2:
> end;
>
> procedure TCollection.AtDelete(Index: Integer); assembler; {$USES esi,edi} {$FRAME-}
> asm
> mov edi,Self
> mov edx,Index
> test edx,edx
> jl @@1
> cmp edx,[edi].TCollection.Count
> jge @@1
> dec [edi].TCollection.Count
> mov ecx,[edi].TCollection.Count
> sub ecx,edx
> je @@2
> cld
> mov edi,[edi].TCollection.Items
> lea edi,[edi+edx*4]
> lea esi,[edi+4]
> rep movsd
> jmp @@2
> @@1:
> mov al,coIndexError
> Call CollectionError
> @@2:
1946c1475
< procedure TCollection.AtInsert(Index: Integer; Item: Pointer); assembler;
> procedure TCollection.AtInsert(Index: Integer; Item: Pointer); assembler; {USES esi, edi} {$FRAME-}
1948,2019c1477,1537
< LES DI,Self
> mov edi,Self
> mov edx,Index
> test edx,edx
> jl @@3
> mov ecx,[edi].TCollection.Count
> cmp edx,ecx
> jg @@3
> cmp ecx,[edi].TCollection.Limit
> jne @@1
> push ecx
> push edx
> add ecx,[edi].TCollection.Delta
> push ecx { [1]:DWord = ALimit }
> push edi { [2]:Pointer = Self }
> mov eax,[edi]
> Call DWord Ptr [eax].TCollection_SetLimit
> pop edx
> pop ecx
> cmp ecx,[edi].TCollection.Limit
> je @@4
> @@1:
> inc [edi].TCollection.Count
> std
> mov edi,[edi].TCollection.Items
> lea edi,[edi+ecx*4]
> sub ecx,edx
> je @@2
> lea esi,[edi-4]
> rep movsd
> @@2:
> mov eax,Item
> stosd
> cld
> jmp @@6
> @@3:
> mov al,coIndexError
> jmp @@5
> @@4:
> mov al,coOverflow
> mov edx,ecx
> @@5:
> Call CollectionError
> @@6:
> end;
>
> procedure TCollection.AtPut(Index: Integer; Item: Pointer); assembler; {$USES edi} {$FRAME-}
> asm
> mov eax,Item
> mov edi,Self
> mov edx,Index
> test edx,edx
> jl @@1
> cmp edx,[edi].TCollection.Count
> jge @@1
> mov edi,[edi].TCollection.Items
> mov [edi+edx*4],eax
> jmp @@2
> @@1:
> mov al,coIndexError
> Call CollectionError
> @@2:
2037c1555
< function TCollection.FirstThat(Test: Pointer): Pointer; assembler;
> function TCollection.FirstThat(Test: Pointer): Pointer; assembler; {$USES ebx} {$FRAME-}
2039,2095c1557,1596
< LES DI,Self
> mov edx,Self
> mov ecx,[edx].TCollection.Count
> jecxz @@3
> mov ebx,Test
> mov edx,[edx].TCollection.Items
> @@1:
> push edx
> push ecx
> push DWord Ptr [edx] { [1]:Pointer = Item }
> Call ebx
> pop ecx
> pop edx
> test al,al
> jnz @@2
> add edx,4
> loop @@1
> jmp @@3
> @@2:
> mov ecx,[edx]
> @@3:
> mov eax,ecx
> end;
>
> procedure TCollection.ForEach(Action: Pointer); assembler; {$USES ebx} {$FRAME-}
> asm
> mov edx,Self
> mov ecx,[edx].TCollection.Count
> jecxz @@2
> mov ebx,Action
> mov edx,[edx].TCollection.Items
> @@1:
> push edx
> push ecx
> push DWord Ptr [edx] { [1]:Pointer = Item }
> Call ebx
> pop ecx
> pop edx
> add edx,4
> loop @@1
> @@2:
2122c1623
< function TCollection.IndexOf(Item: Pointer): Integer; assembler;
> function TCollection.IndexOf(Item: Pointer): Integer; assembler; {$USES edi} {$FRAME-}
2124,2149c1625,1642
< MOV AX,Item.Word[0]
> mov eax,Item
> mov edi,Self
> mov ecx,[edi].TCollection.Count
> jecxz @@1
> mov edi,[edi].TCollection.Items
> mov edx,edi
> cld
> repne scasd
> jne @@1
> mov eax,edi
> sub eax,edx
> shr eax,2
> dec eax
> jmp @@2
> @@1:
> xor eax,eax
> dec eax
> @@2:
2157c1650
< function TCollection.LastThat(Test: Pointer): Pointer; assembler;
> function TCollection.LastThat(Test: Pointer): Pointer; assembler; {$USES ebx} {$FRAME-}
2159,2223c1652,1694
< LES DI,Self
> mov edx,Self
> mov ecx,[edx].TCollection.Count
> jecxz @@3
> mov edx,[edx].TCollection.Items
> lea edx,[edx+ecx*4]
> mov ebx,Test
> @@1:
> sub edx,4
> push edx
> push ecx
> push DWord Ptr [edx] { [1]:Pointer = Item }
> Call ebx
> pop ecx
> pop edx
> test al,al
> jnz @@2
> loop @@1
> jmp @@3
> @@2:
> mov ecx,[edx]
> @@3:
> mov eax,ecx
> end;
>
> procedure TCollection.Pack; assembler; {$USES esi,edi} {$FRAME-}
> asm
> mov edx,Self
> mov ecx,[edx].TCollection.Count
> jecxz @@3
> mov edi,[edx].TCollection.Items
> mov esi,edi
> cld
> @@1:
> lodsd
> test eax,eax
> jz @@2
> stosd
> @@2:
> loop @@1
> sub edi,[edx].TCollection.Items
> shr edi,2
> mov [edx].TCollection.Count,edi
> @@3:
2253c1724
< procedure DoPutItem(P: Pointer); far;
> procedure DoPutItem(P: Pointer);
2338a1810,1811
> {$USES esi,edi} {$FRAME-}
>
2341,2359c1814,1832
< PUSH DS
> cld
> xor eax,eax
> xor edx,edx
> mov esi,Key1
> mov edi,Key2
> lodsb
> mov dl,[edi]
> inc edi
> mov ecx,eax
> cmp cl,dl
> jbe @@1
> mov cl,dl
> @@1:
> repe cmpsb
> je @@2
> mov al,[esi-1]
> mov dl,[edi-1]
> @@2:
> sub eax,edx
2399,2400d1871
< {$IFNDEF Windows }
2441c1912
< function TResourceCollection.KeyOf(Item: Pointer): Pointer; assembler;
> function TResourceCollection.KeyOf(Item: Pointer): Pointer; assembler; {$USES None} {$FRAME-}
2443,2445c1914,1915
< MOV AX,Item.Word[0]
> mov eax,Item
> add eax,OFFSET TResourceItem.Key
2459,2460d1928
< {$IFDEF NewExeFormat}
2462,2473c1930,1941
< eHdrSize: Word;
> eHdrSize: SmallWord;
> eMinAbove: SmallWord;
> eMaxAbove: SmallWord;
> eInitSS: SmallWord;
> eInitSP: SmallWord;
> eCheckSum: SmallWord;
> eInitPC: SmallWord;
> eInitCS: SmallWord;
> eRelocOfs: SmallWord;
> eOvlyNum: SmallWord;
> eRelocTab: SmallWord;
> eSpace: array [1..30] of Byte;
2477,2478d1944
< {$ENDIF}
2480c1946
< Signature: Word;
> Signature: SmallWord;
2483,2485c1949,1951
< LastCount: Word;
> LastCount: SmallWord;
> PageCount: SmallWord;
> ReloCount: SmallWord);
2487c1953
< InfoType: Word;
> InfoType: SmallWord;
2494,2495d1959
< {$IFDEF NewExeFormat}
2498,2499d1961
< {$ENDIF}
2513,2515c1975
< {$IFDEF NewExeFormat}
> $5A4D: { 'MZ' }
2521c1981
< $454E:
> $584C: { 'LX' }
2526c1986
< $4246:
> $4246: { 'FB' }
2530c1990
< $5250: {Found Resource}
> $5250: {'PR': Found Resource}
2535,2536c1995,1996
< $4C42: Dec(BasePos, Header.InfoSize - 8); {Found BackLink}
> $4C42: Dec(BasePos, Header.InfoSize - 8); {'BL': Found BackLink}
> $4648: Dec(BasePos, SizeOf(THeader) * 2); {'HF': Found HelpFile}
2541,2542c2001,2002
< $424E:
> $424E: { 'NB' }
> if Header.InfoType = $3230 then { '02': Found Debug Info}
2547,2564d2006
<
2665c2107
< procedure DoCopyResource(Item: PResourceItem); far;
> procedure DoCopyResource(Item: PResourceItem);
2710c2152
< function TStringList.Get(Key: Word): String; assembler;
> function TStringList.Get(Key: Word): String; assembler; {$USES ebx,esi,edi} {$FRAME+}
2712,2741c2154,2180
< PUSH DS
> mov esi,Self
> mov edi,@Result
> cld
> mov ecx,[esi].TStringList.IndexSize
> jecxz @@2
> mov ebx,Key
> mov esi,[esi].TStringList.Index
> @@1:
> mov edx,ebx
> lodsd
> sub edx,eax
> lodsd
> cmp edx,eax
> lodsd
> jb @@3
> loop @@1
> @@2:
> xor al,al { Empty string }
> stosb
> jmp @@4
> @@3:
> push edi { [1]:Pointer = String }
> push eax { [2]:DWord = Offset }
> push edx { [3]:DWord = Skip }
> push Self { [4]:Pointer = Self }
> Call TStringList.ReadStr
> @@4:
2806c2245
< procedure CheckEmpty; near; assembler;
> procedure CheckEmpty; assembler; {$USES None} {$FRAME-}
2808,2970c2247,2399
< MOV AX,ES:[DI].TRect.A.X
> mov eax,[edi].TRect.A.X
> cmp eax,[edi].TRect.B.X
> jge @@1
> mov eax,[edi].TRect.A.Y
> cmp eax,[edi].TRect.B.Y
> jl @@2
> @@1:
> cld
> xor eax,eax
> stosd
> stosd
> stosd
> stosd
> @@2:
> end;
>
> procedure TRect.Assign(XA, YA, XB, YB: Integer); assembler; {$USES edi} {$FRAME-}
> asm
> mov edi,Self
> cld
> mov eax,XA
> stosd
> mov eax,YA
> stosd
> mov eax,XB
> stosd
> mov eax,YB
> stosd
> end;
>
> procedure TRect.Copy(R: TRect); assembler; {$USES esi,edi} {$FRAME-}
> asm
> mov esi,R
> mov edi,Self
> cld
> movsd
> movsd
> movsd
> movsd
> end;
>
> procedure TRect.Move(ADX, ADY: Integer); assembler; {$USES None} {$FRAME-}
> asm
> mov ecx,Self
> mov eax,ADX
> add [ecx].TRect.A.X,eax
> add [ecx].TRect.B.X,eax
> mov eax,ADY
> add [ecx].TRect.A.Y,eax
> add [ecx].TRect.B.Y,eax
> end;
>
> procedure TRect.Grow(ADX, ADY: Integer); assembler; {$USES edi} {$FRAME-}
> asm
> mov edi,Self
> mov eax,ADX
> sub [edi].TRect.A.X,eax
> add [edi].TRect.B.X,eax
> mov eax,ADY
> sub [edi].TRect.A.Y,eax
> add [edi].TRect.B.Y,eax
> Call CheckEmpty
> end;
>
> procedure TRect.Intersect(R: TRect); assembler; {$USES esi,edi} {$FRAME-}
> asm
> mov esi,R
> mov edi,Self
> cld
> lodsd
> scasd
> jle @@1
> sub edi,4
> stosd
> @@1:
> lodsd
> scasd
> jle @@2
> sub edi,4
> stosd
> @@2:
> lodsd
> scasd
> jge @@3
> sub edi,4
> stosd
> @@3:
> lodsd
> scasd
> jge @@4
> sub edi,4
> stosd
> @@4:
> sub edi,TYPE TRect
> Call CheckEmpty
> end;
>
> procedure TRect.Union(R: TRect); assembler; {$USES esi,edi} {$FRAME-}
> asm
> mov esi,R
> mov edi,Self
> cld
> lodsd
> scasd
> jge @@1
> sub edi,4
> stosd
> @@1:
> lodsd
> scasd
> jge @@2
> sub edi,4
> stosd
> @@2:
> lodsd
> scasd
> jle @@3
> sub edi,4
> stosd
> @@3:
> lodsd
> scasd
> jle @@4
> sub edi,4
> stosd
> @@4:
> end;
>
> function TRect.Contains(P: TPoint): Boolean; assembler; {$USES None} {$FRAME-}
> asm
> mov ecx,Self
> mov al,0
> mov edx,P.X
> cmp edx,[ecx].TRect.A.X
> jl @@1
> cmp edx,[ecx].TRect.B.X
> jge @@1
> mov edx,P.Y
> cmp edx,[ecx].TRect.A.Y
> jl @@1
> cmp edx,[ecx].TRect.B.Y
> setl al
> @@1:
> end;
>
> function TRect.Equals(R: TRect): Boolean; assembler; {$USES esi,edi} {$FRAME-}
> asm
> mov esi,R
> mov edi,Self
> mov ecx,4
> cld
> repe cmpsd
> sete al
2975,2984c2404,2412
< LES DI,Self
> mov ecx,Self
> mov al,1
> mov edx,[ecx].TRect.A.X
> cmp edx,[ecx].TRect.B.X
> jge @@1
> mov edx,[ecx].TRect.A.Y
> cmp edx,[ecx].TRect.B.Y
> setge al
> @@1:
2987,2988d2414
< {$ENDIF}
3014a2441,2549
> end;
>
> { Peforms services analogous to DOS INT 21h Fns: 3Ch,3Dh,3Eh,3Fh,40h,42h }
>
> procedure DosFn; assembler; {$USES ecx} {$FRAME+}
> var
> Written,NewPtr,Handle,Result,Fn: Longint;
> asm
> cmp ah,42h
> je @@Seek
> cmp ah,3Fh
> je @@Read
> cmp ah,40h
> je @@Write
> cmp ah,3Eh
> je @@Close { 3Ch, 3Dh }
> { Open or create file}
> mov Fn,eax
> push 0 { [8]:Pointer = @EAs }
> or al,40h { Deny none }
> cmp ah,3Ch
> jne @@1
> mov al,42h { Create: Read/Write access }
> @@1:
> movzx eax,al
> push eax { [7]:DWord = OpenMode }
> mov al,1 { If file exist, open it }
> cmp Fn.Byte[1],3Dh
> je @@2
> mov al,12h { If file doesn't exist, create it, if exist truncate }
> @@2:
> push eax { [6]:DWord = OpenFlags }
> push ecx { [5]:DWord = Attr }
> push 0 { [4]:DWord = File Size }
> lea eax,Result { [3]:Pointer = @OpenResult }
> push eax
> lea eax,Handle { [2]:Pointer = @Handle }
> push eax
> push edx { [1]:Pointer = file name }
> Call DosOpen
> add esp,8*4 { Stack cleanup after "C" call }
> test eax,eax
> stc
> jnz @@RET
> mov eax,Handle
> jmp @@OK
> { Seek file }
> @@Seek:
> lea edx,NewPtr { [4]:Pointer = @NewPtr }
> push edx
> movzx eax,al { [3]:DWord = Method }
> push eax
> push ecx { [2]:DWord = Distance }
> push ebx { [1]:DWord = File Handle }
> Call DosSetFilePtr
> add esp,4*4 { Stack cleanup after "C" call }
> test eax,eax
> stc
> jnz @@RET
> mov eax,NewPtr
> jmp @@OK
> { Read file }
> @@Read:
> lea eax,Written { [4]:Pointer = @BytesRead }
> push eax
> push ecx { [3]:DWord = ReadCount }
> push edx { [2]:Pointer = @Buffer }
> push ebx { [1]:DWord = File Handle }
> Call DosRead
> jmp @@3
> { Write file }
> @@Write:
> jecxz @@Truncate
> lea eax,Written
> push eax { [4]:Pointer = @BytesWritten }
> push ecx { [3]:DWord = WriteCount }
> push edx { [2]:Pointer = @Buffer }
> push ebx { [1]:DWord = File Handle }
> Call DosWrite
> @@3:
> add esp,4*4 { Stack cleanup after "C" call }
> test eax,eax
> stc
> jnz @@RET
> mov eax,Written
> jmp @@OK
> { Write 0 bytes = Truncate file }
> @@Truncate: { Seek mode: Current Pointer }
> mov ax,4201h { ebx = Handle }
> Call DosFn { ecx = 0 = Distance }
> jc @@RET { eax = Current File Pointer }
> push eax { [2]:Longint = New File Size }
> push ebx { [1]:Longint = File Handle }
> Call DosSetFileSize
> add esp,2*4
> test eax,eax
> stc
> jnz @@RET
> jmp @@OK
> { Close file }
> @@Close:
> push ebx { [1]:DWord = File Handle }
> Call DosClose
> test eax,eax
> stc
> jnz @@RET
> @@OK:
> clc
> @@RET:
Comparing BP7\VALIDATE.PAS and VP\VALIDATE.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects;
> uses Objects, Use32;
168,170d167
< {$IFDEF Windows}
172d168
< {$ENDIF Windows}
255,267d250
< {$IFDEF Windows}
274,275d256
< {$ENDIF Windows}
293c274
< function IsNumber(Chr: Char): Boolean; near; assembler;
> function IsNumber(Chr: Char): Boolean; assembler; {$USES None} {$FRAME-}
295,302c276,282
< XOR AL,AL
> xor al,al
> mov ah,Chr
> cmp ah,'0'
> jb @@1
> cmp ah,'9'
> setbe al
> @@1:
305c285
< function IsLetter(Chr: Char): Boolean; near; assembler;
> function IsLetter(Chr: Char): Boolean; assembler; {$USES None] {$FRAME-}
307,315c287,294
< XOR AL,AL
> xor al,al
> mov ah,Chr
> and ah,0DFH { To upper }
> cmp ah,'A'
> jb @@1
> cmp ah,'Z'
> setbe al
> @@1:
318,319c297,299
< function IsSpecial(Chr: Char; const Special: string): Boolean; near;
> {$USES edi} {$FRAME-}
>
> function IsSpecial(Chr: Char; const Special: String): Boolean; assembler;
321,331c301,308
< XOR AH,AH
> xor ecx,ecx
> mov edi,Special
> mov cl,[edi]
> inc edi
> mov al,Chr
> cld
> repne scasb
> sete al
337c314,316
< function NumChar(Chr: Char; const S: string): Byte; near; assembler;
> {$USES edi} {$FRAME-}
>
> function NumChar(Chr: Char; const S: String): Byte; assembler;
339,350c318,330
< XOR AH,AH
> xor ecx,ecx
> xor eax,eax
> mov edi,S
> mov cl,[edi]
> mov al,Chr
> @@1:
> repne scasb
> jne @@2
> inc ah
> test ecx,ecx
> jnz @@1
> @@2:
> mov al,ah
773,781d752
< {$IFDEF Windows}
787,788d757
< {$ENDIF Windows}
805,819d773
< {$IFDEF Windows}
830,831d783
< {$ENDIF Windows}
907,916d858
< {$IFDEF Windows}
922,923d863
< {$ENDIF Windows}
929,933c869
< asm
> Str := @S;
Comparing BP7\APP.PAS and VP\APP.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Memory, HistList, Views, Menus, Dialogs;
> uses Objects, Drivers, Memory, HistList, Views, Menus, Dialogs, Use32;
240c240
< uses Dos;
> uses Dos, Os2Base;
379c379
< function ISqr(X: Integer): Integer; assembler;
> function ISqr(X: Integer): Integer; assembler; {$USES ebx} {$FRAME-}
381,389c381,389
< MOV CX,X
> mov ecx,X
> xor ebx,ebx
> @@1:
> inc ebx
> mov eax,ebx
> imul eax
> cmp eax,ecx
> jle @@1
> lea eax,[ebx-1]
430c430
< DividerLoc := LongDiv(LongMul(Hi - Lo, Pos), Num) + Lo;
> DividerLoc := ((Hi - Lo) * Pos) div Num + Lo;
612a613
> DosSleep(31);
766d766
< SwapVectors;
768d767
< SwapVectors;
770a770
> InitKeyboard;
809c809
< PrintStr('Type EXIT to return...');
> PrintStr(#13#10'Type EXIT to return...'#13#10);
Comparing BP7\COLORSEL.PAS and VP\COLORSEL.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Views, Dialogs;
> uses Objects, Drivers, Views, Dialogs, Use32;
Comparing BP7\DRIVERS.PAS and VP\DRIVERS.PAS
10a11,18
> { Drivers unit has been rewritten completely. }
> { OS/2 system error handler is used, so SysErrorFunc, }
> { SystemError,SysColorAttr,SysMonoAttr and SaveInt09 }
> { are not available. MouseIntFlag variable is not }
> { supported also. }
> { New services are introduced to support keystroke }
> { macros. }
>
13,14c21
< {$X+,I-,S-,P-}
> {$X+,I-,S-,P-,Cdecl-}
18c25
< uses Objects;
> uses Objects, Use32;
80a88,119
> { Additional keyboard codes that Borland forgot to define }
>
> kbCtrlA = $1E01; kbCtrlB = $3002; kbCtrlC = $2E03;
> kbCtrlD = $2004; kbCtrlE = $1205; kbCtrlF = $2106;
> kbCtrlG = $2207; kbCtrlH = $2308; kbCtrlI = $1709;
> kbCtrlJ = $240A; kbCtrlK = $250B; kbCtrlL = $260C;
> kbCtrlM = $320D; kbCtrlN = $310E; kbCtrlO = $180F;
> kbCtrlP = $1910; kbCtrlQ = $1011; kbCtrlR = $1312;
> kbCtrlS = $1F13; kbCtrlT = $1414; kbCtrlU = $1615;
> kbCtrlV = $2F16; kbCtrlW = $1117; kbCtrlX = $2D18;
> kbCtrlY = $1519; kbCtrlZ = $2C1A;
>
> { 101-key AT keyboard }
>
> kbAltTab = $A500; kbAltDel = $A300; kbAltIns = $A200;
> kbAltPgDn = $A100; kbAltDown = $A000; kbAltEnd = $9F00;
> kbAltRight = $9D00; kbAltLeft = $9B00; kbAltPgUp = $9900;
> kbAltUp = $9800; kbAltHome = $9700; kbCtrlTab = $9400;
> kbCtrlGreyPlus=$9000; kbCtrlCenter = $8F00; kbCtrlMinus = $8E00;
> kbCtrlUp = $8D00; kbAltF12 = $8C00; kbAltF11 = $8B00;
> kbCtrlF12 = $8A00; kbCtrlF11 = $8900; kbShiftF12 = $8800;
> kbShiftF11 = $8700; kbF12 = $8600; kbF11 = $8500;
> kbAltGrayPlus= $4E00; kbCenter = $4C00; kbAltGreyAst= $3700;
> kbAltSlash = $3500; kbAltPeriod = $3400; kbAltComma = $3300;
> kbAltBackSlash=$2B00; kbAltOpQuote = $2900; kbAltQuote = $2800;
> kbAltSemicolon=$2700; kbAltRgtBrack= $1B00; kbAltLftBrack=$1A00;
> kbAltEsc = $0100; kbCtrlDown = $9100;
>
> { Special keys }
>
> kbAltShiftBack = $0900;
>
112c151,152
< 0: (KeyCode: Word);
> 0: (KeyCode: SmallWord;
> ShiftState: Byte);
125a166,168
> TShiftStateHandler = function(var ShiftState: Byte): Boolean;
> TCtrlBreakAction = procedure;
>
134a178,180
> GetShiftStateHandler: TShiftStateHandler = nil;
> CtrlBreakAction: TCtrlBreakAction = nil;
> KeyDownMask: Word = evKeyDown;
137,140d182
<
147a190,192
> { These procedures are called from BASM code, }
> { so they should not change registers }
> {$SAVES ALL}
149a195,196
> procedure UpdateMouseWhere;
> {$SAVES ebx,esi,edi}
169a217
> CheckSnow: Boolean = False; { not used }
179d226
< CheckSnow: Boolean;
181c228
< CursorLines: Word;
> CursorLines: SmallWord;
190,194c237
< { ******** SYSTEM ERROR HANDLER ******** }
> { Keyboard }
196c239
< TSysErrorFunc = function(ErrorCode: Integer; Drive: Byte): Integer;
> procedure InitKeyboard;
198,203d240
< { Default system error handler routine }
206,209c243
< SaveInt09: Pointer = nil;
> const
211c245
< SaveCtrlBreak: Boolean = False;
> SaveCtrlBreak: Boolean = False; { not used }
213c247
< FailSysErrors: Boolean = False;
> FailSysErrors: Boolean = False; { not used }
245,249c279
< { ******** EVENT MANAGER ******** }
> uses Dos, Os2Def, Os2Base, Xcpt;
251c281
< EventQSize = 16;
> { ******** EVENT MANAGER ******** }
260d289
< LastWhere: TPoint;
265,269d293
< EventCount: Word;
271,273c295,297
< var
> hMou: SmallWord;
> ProtectArea: NoPtrRect;
> MouseMSec: Longint;
275c299,301
< { Detect mouse driver }
> VioMode: VioModeInfo;
> StartupVioMode: VioModeInfo;
> StartupCursor: VioCursorInfo;
277,295c303
< procedure DetectMouse; near; assembler;
> { Detects mouse driver, moves mouse pointer to the top left corner }
297c305,319
< { Store event in GetMouseEvent and GetKeyEvent }
> procedure DetectMouse;
> var
> MouLoc: PtrLoc;
> Buttons: SmallWord;
> begin
> ButtonCount := 0;
> if MouOpen(nil, hMou) = 0 then
> begin
> MouGetNumButtons(Buttons,hMou);
> ButtonCount := Buttons;
> MouLoc.Row := 0;
> MouLoc.Col := 0;
> MouSetPtrPos(MouLoc, hMou);
> end;
> end;
299,317c321
< procedure StoreEvent; near; assembler;
> { Shows mouse pointer }
319,354c323,327
< procedure GetMouseState; near; assembler;
> procedure ShowMouse;
> var
> Status: SmallWord;
> begin
> if ButtonCount <> 0 then MouDrawPtr(hMou);
357,391c330
< procedure MouseInt; far; assembler;
> { Hides mouse pointer }
393,425c332,334
< procedure InitEvents; assembler;
> procedure HideMouse;
> begin
> if ButtonCount <> 0 then MouRemovePtr(ProtectArea, hMou);
428,442c337,357
< procedure DoneEvents; assembler;
> { Initializes Turbo Vision's event manager by setting event mask and }
> { showing the mouse. Called automatically by TApplication.Init. }
>
> procedure InitEvents;
> var
> MouLoc: PtrLoc;
> EventMask: SmallWord;
> begin
> if ButtonCount <> 0 then
> begin { Mouse is available }
> DownButtons := 0;
> LastDouble := False;
> MouGetPtrPos(MouLoc, hMou);
> MouseWhere.X := MouLoc.Col;
> MouseWhere.Y := MouLoc.Row;
> MouDrawPtr(hMou);
> LastButtons := 0; { Assume that no button is pressed }
> EventMask := $FFFF;
> MouSetEventMask(EventMask, hMou); { Select all events }
> MouseEvents := True;
> end;
445,453c360,373
< procedure ShowMouse; assembler;
> { Terminates Turbo Vision's event manager and hides the mouse. Called }
> { automatically by TApplication.Done. }
>
> procedure DoneEvents;
> var
> EventMask: SmallWord;
> begin
> if ButtonCount <> 0 then
> begin
> HideMouse;
> EventMask := 0;
> MouSetEventMask(EventMask, hMou); { Mask all events }
> MouseEvents := False;
> end;
456,464c376,406
< procedure HideMouse; assembler;
> { Checks whether a mouse event is available by polling the mouse event }
> { queue maintained by OS/2. If a mouse event has occurred, Event.What }
> { is set to evMouseDown, evMouseUp,evMouseMove, or evMouseAuto; }
> { Event.Buttons is set to mbLeftButton or mbRightButton; }
> { Event.Double is set to True or False;
> { Event.Where is set to the mouse position in global coordinates. }
> { If no mouse events are available, Event.What is set to evNothing. }
> { GetMouseEvent is called by TProgram.GetEvent. }
>
> procedure GetMouseEvent(var Event: TEvent);
> var
> MouEvent: MouEventInfo;
> MouQInfo: MouQueInfo;
> CurTicks: Word;
> B1,B2: Byte;
> const
> WaitFlag: SmallWord = mou_NoWait;
>
> procedure StoreEvent(MouWhat: Word);
> begin
> LastButtons := MouseButtons;
> MouseWhere.X := MouEvent.Col;
> MouseWhere.Y := MouEvent.Row;
> with Event do
> begin
> What := MouWhat;
> Buttons := MouseButtons;
> Double := LastDouble;
> Where.X := MouEvent.Col;
> Where.Y := MouEvent.Row;
> end;
467,528c409,472
< procedure GetMouseEvent(var Event: TEvent); assembler;
> { GetMouseEvent body }
>
> begin
> if not MouseEvents then Event.What := evNothing
> else
> begin
> MouGetNumQueEl(MouQInfo, hMou);
> if MouQinfo.cEvents = 0 then
> begin
> MouseButtons := LastButtons;
> DosQuerySysInfo(qsv_Ms_Count, qsv_Ms_Count, MouEvent.Time, SizeOf(MouEvent.Time));
> MouEvent.Col := MouseWhere.X;
> MouEvent.Row := MouseWhere.Y;
> end
> else
> begin
> MouReadEventQue(MouEvent, WaitFlag, hMou);
> if MouseReverse then
> begin
> B1 := mbRightButton;
> B2 := mbLeftButton;
> end
> else
> begin
> B1 := mbLeftButton;
> B2 := mbRightButton;
> end;
> if (MouEvent.fs and (mouse_Motion_With_Bn1_Down or mouse_Bn1_Down)) <> 0
> then MouseButtons := B1 else MouseButtons := 0;
> if (MouEvent.fs and (mouse_Motion_With_Bn2_Down or mouse_Bn2_Down)) <> 0
> then MouseButtons := MouseButtons or B2;
> end;
> { ms -> ticks: 1 DOS timer tick = 55ms }
> CurTicks := MouEvent.Time div 55;
> MouseMSec := MouEvent.Time;
> { Process mouse event }
> if (LastButtons <> 0) and (MouseButtons = 0) then StoreEvent(evMouseUp) { button is released }
> else
> if LastButtons = MouseButtons then
> begin
> if (MouEvent.Row <> MouseWhere.Y) or (MouEvent.Col <> MouseWhere.X) then StoreEvent(evMouseMove)
> else
> if (MouseButtons <> 0) and ((CurTicks - AutoTicks) >= AutoDelay) then
> begin
> AutoTicks := CurTicks;
> AutoDelay := 1;
> StoreEvent(evMouseAuto);
> end
> else StoreEvent(evNothing);
> end
> else { CurButton <> 0, LastButton = 0 }
> begin
> LastDouble := False;
> if (MouseButtons = DownButtons) and (MouEvent.Row = DownWhere.Y) and (MouEvent.Col = DownWhere.X)
> and ((CurTicks - DownTicks) < DoubleDelay) then LastDouble := True;
> DownButtons := MouseButtons;
> DownWhere.Y := MouEvent.Row;
> DownWhere.X := MouEvent.Col;
> DownTicks := CurTicks;
> AutoTicks := CurTicks;
> AutoDelay := RepeatDelay;
> StoreEvent(evMouseDown);
> end;
> end;
531,544c475,485
< procedure GetKeyEvent(var Event: TEvent); assembler;
> { Initializes keyboard. Setups keyboard BINARY mode that allows Ctrl-C }
> { to be handled in a normal way as an ordinal keystroke. }
>
> procedure InitKeyboard;
> var
> Key: KbdInfo;
> begin
> Key.cb := SizeOf(KbdInfo);
> KbdGetStatus(Key,0); { Disable ASCII & Enable raw (binary) mode}
> Key.fsMask := (Key.fsMask and (not keyboard_Ascii_Mode)) or keyboard_Binary_Mode;
> KbdSetStatus(Key,0);
547,550c488,508
< function GetShiftState: Byte; assembler;
> { UpdateMouseWhere is called from Views.WriteView procedure just before }
> { output to screen is to occur. It's too slow to query mouse pointer }
> { location each time this procedure is called. That's why appoximate }
> { approach is used instead. Mouse pointer location is queried only }
> { after some defined time interval (5ms) elapsed since pointer location }
> { was known exactly. Surely, this doesn't fix the mouse "dropping" }
> { problem completely, however experiments show rather good results. }
>
> procedure UpdateMouseWhere;
> var
> MouLoc: PtrLoc;
> MSec: Longint;
> begin
> DosQuerySysInfo(qsv_Ms_Count, qsv_Ms_Count, MSec, SizeOf(MSec));
> if MSec - MouseMSec >= 5 then
> begin
> MouseMSec := MSec;
> MouGetPtrPos(MouLoc, hMou);
> MouseWhere.X := MouLoc.Col;
> MouseWhere.Y := MouLoc.Row;
> end;
553c511,514
< { ******** SCREEN MANAGER ******** }
> { Checks whether a keyboard event is available. If a key has been }
> { pressed, Event.What is set to evKeyDown and Event.KeyCode is set to }
> { the scan code of the key. Otherwise, Event.What is set to evNothing. }
> { GetKeyEvent is called by TProgram.GetEvent. }
554a516
> procedure GetKeyEvent(var Event: TEvent);
556,558c518,527
< Equipment: Word absolute $40:$10;
> Key: KbdKeyInfo;
> I: Integer;
> { Keyboard scan codes }
> const
> scSpace = $39; scIns = $52; scDel = $53;
> scBack = $0E; scUp = $48; scDown = $50;
> scLeft = $4B; scRight = $4D; scHome = $47;
> scEnd = $4F; scPgUp = $49; scPgDn = $51;
> scCtrlIns = $92; scCtrlDel = $93; scCtrlUp = $8D;
> scCtrlDown = $91;
560c529,530
< { Save registers and call video interrupt }
> const
> kbShift = kbLeftShift + kbRightShift;
562,568c532,583
< procedure VideoInt; near; assembler;
> type
> KeyTransEntry = record
> Scan: Byte;
> Shift: Byte;
> Code: Word;
> end;
>
> const
> KeyTranslateTable : array [1..15] of KeyTransEntry =
> (( Scan: scSpace ; Shift: kbAltShift ; Code: kbAltSpace ), { Alt-Space }
> ( Scan: scIns ; Shift: kbCtrlShift ; Code: kbCtrlIns ), { Ctrl-Ins }
> ( Scan: scCtrlIns ; Shift: kbCtrlShift ; Code: kbCtrlIns ), { Ctrl-Ins }
> ( Scan: scIns ; Shift: kbLeftShift ; Code: kbShiftIns ), { Shift-Ins }
> ( Scan: scIns ; Shift: kbRightShift ; Code: kbShiftIns ), { Shift-Ins }
> ( Scan: scIns ; Shift: kbShift ; Code: kbShiftIns ), { Shift-Ins }
> ( Scan: scDel ; Shift: kbCtrlShift ; Code: kbCtrlDel ), { Ctrl-Del }
> ( Scan: scCtrlDel ; Shift: kbCtrlShift ; Code: kbCtrlDel ), { Ctrl-Del }
> ( Scan: scDel ; Shift: kbLeftShift ; Code: kbShiftDel ), { Shift-Del }
> ( Scan: scDel ; Shift: kbRightShift ; Code: kbShiftDel ), { Shift-Del }
> ( Scan: scDel ; Shift: kbShift ; Code: kbShiftDel ), { Shift-Del }
> ( Scan: scBack ; Shift: kbAltShift+kbLeftShift ; Code: kbAltShiftBack), { Alt-Shift-Backspace }
> ( Scan: scBack ; Shift: kbAltShift+kbRightShift; Code: kbAltShiftBack), { Alt-Shift-Backspace }
> ( Scan: scBack ; Shift: kbAltShift+kbShift ; Code: kbAltShiftBack), { Alt-Shift-Backspace }
> ( Scan: scBack ; Shift: kbAltShift ; Code: kbAltBack )); { Alt-Backspace }
> begin
> KbdCharIn(Key, io_NoWait, 0);
> if (Key.fbStatus and kbdtrf_Final_Char_In) = 0 then Event.What := evNothing
> else
> begin
> with Event do { Key is ready }
> begin
> What := KeyDownMask;
> CharCode := Key.chChar;
> ScanCode := Key.chScan;
> ShiftState := Key.fsState;
> for I := Low(KeyTranslateTable) to High(KeyTranslateTable) do
> with KeyTranslateTable[I] do
> begin
> if (Scan = Key.chScan ) and ((Shift and Key.fsState) = Shift) then
> begin
> KeyCode := Code;
> Break;
> end;
> end;
> if (CharCode = #$E0) and (ScanCode in
> [scUp,scDown,scLeft,scRight,scIns,scDel,scHome,scEnd,scPgUp,scPgDn,
> Hi(kbCtrlHome), Hi(kbCtrlEnd) , Hi(kbCtrlPgUp), Hi(kbCtrlPgDn),
> Hi(kbCtrlLeft), Hi(kbCtrlRight), scCtrlUp, scCtrlDown])
> then CharCode := #0; { Grey Keys }
> if KeyCode = $E00D then KeyCode := kbEnter; { Grey Enter }
> end;
> end;
571c586,588
< { Return CRT mode in AX and dimensions in DX }
> { Returns a byte containing the current Shift key state, as reported by }
> { OS/2. The return value contains a combination of the kbXXXX constants }
> { for shift states. }
573,586c590,604
< procedure GetCrtMode; near; assembler;
> function GetShiftState: Byte;
> var
> Key: KbdInfo;
> ShiftState: Byte;
> Handled: Boolean;
> begin
> if @GetShiftStateHandler <> nil then Handled := GetShiftStateHandler(ShiftState)
> else Handled := False;
> if not Handled then
> begin
> Key.cb := SizeOf(KbdInfo);
> KbdGetStatus(Key, 0);
> ShiftState := Key.fsState;
> end;
> GetShiftState := ShiftState;
589c607
< { Set CRT mode to value in AX }
> { ******** SCREEN MANAGER ******** }
591,623c609,626
< procedure SetCrtMode; near; assembler;
> { Returns current CRT mode }
>
> function GetCrtMode: Word;
> var
> Mode: Word;
> begin
> VioMode.cb := SizeOf(VioMode);
> VioGetMode(VioMode, 0);
> with VioMode do
> begin
> if (fbType and vgmt_DisableBurst) = 0
> then Mode := smCO80 else Mode := smBW80;
> if Color = 0 then Mode := smMono;
> if Row > 25 then Inc(Mode, smFont8x8);
> GetCrtMode := Mode;
> if ((VioMode.fbType and vgmt_Graphics) <> 0) or
> (Col <> 80) then GetCrtMode := 0;
> end;
626c629
< { Fix CRT mode in AX if required }
> { Setups CRT mode }
628,637c631,669
< procedure FixCrtMode; near; assembler;
> procedure SetCrtMode(Mode: Word);
> var
> BiosMode: Byte;
> CurData: VioCursorInfo;
> VideoConfig: VioConfigInfo;
> begin
> BiosMode := Lo(Mode);
> VideoConfig.cb := SizeOf(VideoConfig);
> VioGetConfig(0, VideoConfig, 0);
> with VioMode do
> begin
> cb := SizeOf(VioMode);
> fbType := vgmt_Other;
> Color := colors_16; { Color }
> Row := 25; { 80x25 }
> Col := 80;
> VRes := 400;
> HRes := 720;
> if (Mode and smFont8x8) <> 0 then
> case VideoConfig.Adapter of { 80x43 }
> display_Monochrome..display_CGA: ;
> display_EGA:
> begin
> Row := 43; VRes := 350; HRes := 640;
> end;
> else { 80x50 }
> begin
> Row := 50; VRes := 400; HRes := 720;
> end;
> end;
> case BiosMode of { Black and white }
> smBW80: fbType := vgmt_Other + vgmt_DisableBurst;
> smMono:
> begin { Monochrome }
> HRes := 720; VRes := 350; Color := 0; fbType := 0;
> end;
> end;
> end;
> VioSetMode(VioMode, 0);
640c672
< { Set CRT data areas and mouse range }
> { Fix CRT mode if required }
642,685c674,679
< procedure SetCrtData; near; assembler;
> function FixCrtMode(Mode: Word): Word;
> begin
> case Lo(Mode) of
> smMono,smCO80,smBW80: FixCrtMode := Mode
> else FixCrtMode := smCO80;
> end;
688c682
< { Detect video modes }
> { Sets CRT data areas and mouse range }
690,694c684,708
< procedure DetectVideo; assembler;
> procedure SetCrtData;
> var
> VideoConfig: VioConfigInfo;
> BufSize: SmallWord;
> CurData: VioCursorInfo;
> begin
> ScreenMode := GetCrtMode;
> ScreenHeight := VioMode.Row;
> ScreenWidth := VioMode.Col;
> ProtectArea.Row := 0;
> ProtectArea.Col := 0;
> ProtectArea.cRow := ScreenHeight - 1;
> ProtectArea.cCol := ScreenWidth - 1;
> ShowMouse;
> HiResScreen := False;
> VideoConfig.cb := SizeOf(VideoConfig);
> if (VioGetConfig(0, VideoConfig, 0) = 0) then
> if VideoConfig.Adapter >= display_EGA then HiResScreen := True;
> VioGetBuf(ScreenBuffer,BufSize,0);
> SelToFlat(ScreenBuffer);
> VioGetCurType(CurData, 0); { Get cursor lines }
> WordRec(CursorLines).Hi := CurData.yStart;
> WordRec(CursorLines).Lo := CurData.cEnd;
> CurData.attr := $FFFF;
> VioSetCurType(CurData,0); { Hide cursor }
697,705c711,716
< procedure InitVideo; assembler;
> { Detects video modes }
>
> procedure DetectVideo;
> begin
> ScreenMode := FixCrtMode(GetCrtMode);
> StartupVioMode := VioMode;
708,721c719,730
< procedure DoneVideo; assembler;
> { Initializes Turbo Vision's video manager. Saves the current screen }
> { mode in StartupMode, and switches the screen to the mode indicated by }
> { ScreenMode. The ScreenWidth, ScreenHeight, HiResScreen, ScreenBuffer, }
> { and CursorLines variables are updated accordingly.InitVideo is called }
> { automatically by TApplication.Init. }
>
> procedure InitVideo;
> begin
> VioGetCurType(StartupCursor, 0);
> StartupMode := GetCrtMode;
> if StartupMode <> ScreenMode then SetCrtMode(ScreenMode);
> SetCrtData;
724,729c733,742
< procedure SetVideoMode(Mode: Word); assembler;
> { Terminates Turbo Vision's video manager by restoring the initial }
> { screen mode, clearing the screen, and restoring the cursor. Called }
> { automatically by TApplication.Done. }
>
> procedure DoneVideo;
> begin
> if (StartupMode <> $FFFF) and (StartupMode <> ScreenMode) then
> VioSetMode(StartupVioMode, 0);
> ClearScreen;
> VioSetCurType(StartupCursor, 0);
732,754c745,748
< procedure ClearScreen; assembler;
> { Sets the video mode. Mode is one of the constants smCO80, smBW80, or smMono, }
> { optionally with smFont8x8 added to select 43- or 50-line mode on an EGA or }
> { VGA. SetVideoMode initializes the same variables as InitVideo (except for }
> { the StartupMode variable, which isn't affected). }
756c750,754
< const
> procedure SetVideoMode(Mode: Word);
> begin
> SetCrtMode(FixCrtMode(Mode));
> SetCrtData;
> end;
758c756
< { System error messages }
> { Clears the screen, moves cursor to the top left corner }
760,794c758,764
< SCriticalError: string[31] = 'Critical disk error on drive %c';
> procedure ClearScreen;
> const
> Cell: SmallWord = $0720; { Space character, white on black }
> begin
> VioScrollUp(0, 0, 65535, 65535, 65535, Cell, 0);
> VioSetCurPos(0, 0, 0);
> end;
796c766
< { System error handler routines }
> { ********************* SYSTEM ERROR HANDLER ************************** }
798,799c768,771
< procedure InitSysError; external;
> { No critical error handler is implemented for OS/2. }
> { Default OS/2 system error handler traps all critical errors. }
> { Unlike DOS critical error handler it doesn't corrupt user screen. }
> { That's why it is not so interesting to write one more of your own. }
801,818c773,775
< procedure SwapStatusLine(var Buffer); near; assembler;
> { Ctrl-Break signal handler. Sets CtrlBreakHit to True whenever }
> { Ctrl-Break is hit. Note: when keyboard is switched to the raw }
> { (binary mode) mode xcpt_Signal_Intr signal (Ctrl-C) is not reported. }
820,846c777,791
< function SelectKey: Integer; near; assembler;
> function CtrlBreakHandler(Report: PExceptionReportRecord;
> Registration: PExceptionRegistrationRecord;
> Context: PContextRecord;
> P: Pointer): ULong; cdecl;
> begin
> CtrlBreakHandler := xcpt_Continue_Search;
> if (Report^.ExceptionNum = xcpt_Signal) then
> case Report^.ExceptionInfo[0] of
> xcpt_Signal_Intr,xcpt_Signal_Break:
> begin
> CtrlBreakHit := True;
> if Assigned(CtrlBreakAction) then CtrlBreakAction;
> CtrlBreakHandler := xcpt_Continue_Execution;
> end;
> end;
849c794,796
< {$V-}
> { Initializes Turbo Vision's system error handler. Called automatically }
> { by TApplication.Init. Since no error handler is available,InitSysError}
> { sets SysErrActive to True and does nothing. }
851,856c798
< function SystemError(ErrorCode: Integer; Drive: Byte): Integer;
> procedure InitSysError;
858,874c800
< if FailSysErrors then
> SysErrActive := True;
877c803,810
< {$V+}
> { Terminates Turbo Vision's system error handler. Called automatically }
> { by TApplication.Done. Since no error handler is available,DoneSysError}
> { sets SysErrActive to False and does nothing. }
>
> procedure DoneSysError;
> begin
> SysErrActive := False;
> end;
959,961c892,907
< { String formatting routines }
> { A generalized string formatting routine. Given a string in Format }
> { that includes format specifiers and a list of parameters in Params, }
> { FormatStr produces a formatted output string in Result. }
> { Format specifiers are of the form %[-][nnn]X, where }
> { % indicates the beginning of a format specifier }
> { [-] is an optional minus sign (-) indicating the parameter is to be }
> { left-justified (by default, parameters are right-justified) }
> { [nnn] is an optional, decimal-number width specifier in the range }
> { 0..255 (0 indicates no width specified, and non-zero means to }
> { display in a field of nnn characters) }
> { X is a format character: }
> { 's' means the parameter is a pointer to a string. }
> { 'd' means the parameter is a Longint to be displayed in decimal. }
> { 'c' means the low byte of the parameter is a character. }
> { 'x' means the parameter is a Longint to be displayed in hexadecimal.}
> { '#' sets the parameter index to nnn. }
964c910,915
< external {FORMAT};
> assembler; {$USES ebx,esi,edi} {$FRAME+}
> var
> ParOfs: Longint;
> Buffer: array [1..12] of Byte;
> const
> HexDigits: array [0..15] of Char = '0123456789ABCDEF';
966,978c917,1092
< procedure PrintStr(const S: String); assembler;
> { Convert next parameter to string }
> { EXPECTS: al = Conversion character }
> { RETURNS: esi = Pointer to string }
> { ecx = String length }
>
> procedure Convert; assembler; {$USES None} {$FRAME-}
> asm
> mov edx,eax
> mov esi,Params
> lodsd
> mov Params,esi
> xor ecx,ecx
> lea esi,Buffer[TYPE Buffer]
> and dl,0DFh { UpCase(ConversionChar) }
> cmp dl,'C'
> je @@ConvertChar
> cmp dl,'S'
> je @@ConvertStr
> cmp dl,'D'
> je @@ConvertDec
> cmp dl,'X'
> jne @@Done
> { ConvertHex }
> @@1:
> mov edx,eax
> and edx,0Fh
> mov dl,HexDigits.Byte[edx]
> dec esi
> inc ecx
> mov [esi],dl
> shr eax,4
> jnz @@1
> jmp @@Done
> @@ConvertDec:
> push esi
> mov ebx,eax
> mov ecx,10
> test eax,eax
> jns @@2
> neg eax
> @@2:
> xor edx,edx
> dec esi
> div ecx
> add dl,'0'
> mov [esi],dl
> test eax,eax
> jnz @@2
> pop ecx
> sub ecx,esi
> test ebx,ebx
> jns @@Done
> mov al,'-'
> @@ConvertChar:
> inc ecx
> dec esi
> mov [esi],al
> jmp @@Done
> @@ConvertStr:
> test eax,eax
> jz @@Done
> mov esi,eax
> lodsb
> mov cl,al
> @@Done:
> end;
>
> { FormatStr body }
>
> asm
> mov eax,Params
> mov ParOfs,eax
> xor eax,eax
> mov esi,Format
> mov edi,Result
> inc edi
> cld
> lodsb
> mov ecx,eax
> @@1:
> jecxz @@9
> lodsb
> dec ecx
> cmp al,'%'
> je @@3
> @@2:
> stosb
> jmp @@1
> @@3:
> jecxz @@9
> lodsb
> dec ecx
> cmp al,'%'
> je @@2 { bh = Justify (0:right, 1:left) }
> mov ebx,' ' { bl = Filler character }
> xor edx,edx { edx = Field width (0:no width) }
> cmp al,'0'
> jne @@4
> mov bl,al
> @@4:
> cmp al,'-'
> jne @@5
> inc bh
> jecxz @@9
> lodsb
> dec ecx
> @@5:
> cmp al,'0'
> jb @@6
> cmp al,'9'
> ja @@6
> sub al,'0'
> xchg eax,edx
> mov ah,10
> mul ah
> add al,dl
> xchg eax,edx
> jecxz @@9
> lodsb
> dec ecx
> jmp @@5
> @@6:
> cmp al,'#'
> jne @@10
> shl edx,2
> add edx,ParOfs
> mov Params,edx
> jmp @@1
> @@9:
> mov eax,Result
> mov ecx,edi
> sub ecx,eax
> dec ecx
> mov [eax],cl
> jmp @@Done
> @@10:
> push esi
> push ecx
> push edx
> push ebx
> Call Convert
> pop ebx
> pop edx
> test edx,edx
> jz @@12
> sub edx,ecx
> jae @@12
> test bh,bh
> jnz @@11
> sub esi,edx
> @@11:
> add ecx,edx
> xor edx,edx
> @@12:
> test bh,bh
> jz @@13
> rep movsb { Copy formated parm (left-justified)}
> @@13:
> xchg ecx,edx
> mov al,bl
> rep stosb { Fill unused space }
> xchg ecx,edx
> rep movsb { Copy formated parm (right-justified)}
> pop ecx
> pop esi
> jmp @@1
> @@Done:
> end;
>
> { Prints the string on the screen }
>
> procedure PrintStr(const S: String);
> var
> WCount: ULong;
> begin
> DosWrite(1, S[1], Length(S), WCount);
982a1097,1103
> { Moves text and video attributes into a buffer. Count bytes are moved }
> { from Source into the low bytes of corresponding words in Dest. The }
> { high bytes of the words in Dest are set to Attr, or remain unchanged }
> { if Attr is zero. }
>
> {$USES esi,edi} {$FRAME-}
>
985,1003c1106,1130
< MOV CX,Count
> mov ecx,Count
> jecxz @@4
> mov edi,Dest
> mov esi,Source
> mov ah,Attr
> cld
> test ah,ah
> jz @@3
> @@1:
> lodsb
> stosw
> loop @@1
> jmp @@4
> @@2:
> inc edi
> @@3:
> movsb
> loop @@2
> @@4:
> end;
>
> { Moves characters into a buffer. The low bytes of the first Count }
> { words of Dest are set to C, or remain unchanged if C = #0. The high }
> { bytes of the words are set to Attr, or remain unchanged if Attr is }
> { zero. }
1004a1132,1133
> {$USES edi} {$FRAME-}
>
1007,1024c1136,1170
< MOV CX,Count
> mov ecx,Count
> jecxz @@4
> mov edi,Dest
> mov al,C
> mov ah,Attr
> cld
> test al,al
> jz @@1
> test ah,ah
> jz @@3
> mov edx,eax
> shl eax,16
> mov ax,dx
> shr ecx,1
> rep stosd
> adc ecx,ecx
> rep stosw
> jmp @@4
> @@1:
> mov al,ah
> @@2:
> inc edi
> @@3:
> stosb
> loop @@2
> @@4:
> end;
>
> { Moves a two-colored string into a buffer. The characters in Str are }
> { moved into the low bytes of corresponding words in Dest. The high }
> { bytes of the words are set to Lo(Attr) or Hi(Attr). Tilde characters }
> { (~) in the string toggle between the two attribute bytes passed in }
> { the Attr word. }
>
> {$USES esi,edi} {$FRAME-}
1028,1047c1174,1198
< MOV DX,DS
> xor ecx,ecx
> mov esi,Str
> cld
> lodsb
> mov cl,al
> jecxz @@3
> mov edi,Dest
> mov edx,Attrs
> mov ah,dl
> @@1:
> lodsb
> cmp al,'~'
> je @@2
> stosw
> loop @@1
> jmp @@3
> @@2:
> xchg ah,dh
> loop @@1
> @@3:
> end;
>
> { Moves a string into a buffer. The characters in Str are moved into }
> { the low bytes of corresponding words in Dest. The high bytes of the }
> { words are set to Attr, or remain unchanged if Attr is zero. }
1049,1070c1200
< procedure MoveStr(var Dest; const Str: String; Attr: Byte); assembler;
> {$USES esi,edi} {$FRAME-}
1072c1202
< function CStrLen(const S: String): Integer; assembler;
> procedure MoveStr(var Dest; const Str: String; Attr: Byte); assembler;
1074,1086c1204,1249
< LES DI,S
> xor ecx,ecx
> mov esi,Str
> cld
> lodsb
> mov cl,al
> jecxz @@4
> mov edi,Dest
> mov ah,Attr
> test ah,ah
> jz @@3
> @@1:
> lodsb
> stosw
> loop @@1
> jmp @@4
> @@2:
> inc edi
> @@3:
> movsb
> loop @@2
> @@4:
> end;
>
> { Returns the length of string S, where S is a control string using }
> { tilde characters ('~') to designate shortcut characters. The tildes }
> { are excluded from the length of the string, as they will not appear }
> { on the screen. }
>
> function CStrLen(const S: String): Integer; assembler; {$USES edi} {$FRAME-}
> asm
> xor ecx,ecx
> mov edi,S
> mov cl,[edi]
> inc edi
> mov edx,ecx
> jecxz @@2
> mov al,'~'
> cld
> @@1:
> repne scasb
> jne @@2
> dec edx
> test esp,esp
> jmp @@1
> @@2:
> mov eax,edx
1092a1256
> Times: ULong;
1094c1258
< procedure ExitDrivers; far;
> procedure ExitDrivers;
1097a1262
> MouClose(hMou);
1101a1267
> InitKeyboard;
1105a1272,1273
> DosSetSignalExceptionFocus(True, Times);
> SetExceptionHandler(@CtrlBreakHandler);
Comparing BP7\EDITORS.PAS and VP\EDITORS.PAS
17c17
< uses Drivers, Objects, Views, Dialogs;
> uses Drivers, Objects, Views, Dialogs, Use32;
96c96
< TEditBuffer = array[0..65519] of Char;
> TEditBuffer = array[0..512*1024*1024-1] of Char;
323c323
< sfSearchFailed = $FFFF;
> sfSearchFailed = $FFFFFFFF;
326c326
< FirstKeys: array[0..37 * 2] of Word = (37,
> FirstKeys: array[0..37 * 2] of SmallWord = (37,
346c346
< QuickKeys: array[0..8 * 2] of Word = (8,
> QuickKeys: array[0..8 * 2] of SmallWord = (8,
351c351
< BlockKeys: array[0..5 * 2] of Word = (5,
> BlockKeys: array[0..5 * 2] of SmallWord = (5,
486c486
< if TPoint(Info).Y <= T.Y then
> if TPoint(Info^).Y <= T.Y then
494,527c494,496
< function Min(X, Y: Integer): Integer; near; assembler;
> function Min(X, Y: Integer): Integer;
> begin
> if X <= Y then Min := X else Min := Y;
530,542c499,501
< function CountLines(var Buf; Count: Word): Integer; near; assembler;
> function Max(X, Y: Integer): Integer;
> begin
> if X >= Y then Max := X else Max := Y;
545c504
< function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word; near; assembler;
> function CountLines(var Buf; Count: Word): Integer; assembler; {$USES edi} {$FRAME-}
547,564c506,535
< PUSH DS
> mov edi,Buf
> mov ecx,Count
> xor edx,edx
> mov al,0Dh
> cld
> @@1:
> jecxz @@2
> repne scasb
> jne @@2
> inc edx
> jmp @@1
> @@2:
> mov eax,edx
> end;
>
> function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
> var
> I,Key: Word;
> KeyTable: PWordArray absolute KeyMap;
> begin
> for I := 1 to KeyTable^[0] do
> begin
> Key := KeyTable^[I*2-1];
> if (Lo(Key) = Lo(KeyCode)) and ((Hi(Key) = 0) or (Hi(Key) = Hi(KeyCode))) then
> begin
> ScanKeyMap := KeyTable^[I*2];
> Exit;
> end;
> end;
> ScanKeyMap := 0;
567c538
< function Scan(var Block; Size: Word; Str: String): Word; near; assembler;
> function Scan(var Block; Size: Word; Str: String): Word; assembler; {$USES ebx,esi,edi} {$FRAME-}
569,612c540,586
< PUSH DS
> mov edi,block
> mov esi,Str
> mov ecx,Size
> jecxz @@3
> cld
> lodsb
> cmp al,1
> jb @@5
> ja @@1
> lodsb
> repne scasb
> jne @@3
> jmp @@5
> @@1:
> movzx ebx,al
> dec ebx
> mov edx,ecx
> sub edx,eax
> jb @@3
> lodsb
> inc edx
> inc edx
> @@2:
> dec edx
> mov ecx,edx
> repne scasb
> jne @@3
> mov edx,ecx
> mov ecx,ebx
> rep cmpsb
> je @@4
> sub ecx,ebx
> add esi,ecx
> add edi,ecx
> inc edi
> test edx,edx
> jne @@2
> @@3:
> xor eax,eax
> jmp @@6
> @@4:
> sub edi,ebx
> @@5:
> mov eax,edi
> sub eax,Block
> @@6:
> dec eax
615c589
< function IScan(var Block; Size: Word; Str: String): Word; near; assembler;
> function IScan(var Block; Size: Word; Str: String): Word; assembler; {$USES ebx,esi,edi} {$FRAME+}
619,682c593,661
< PUSH DS
> lea edi,S
> mov esi,Str
> xor eax,eax
> lodsb
> stosb
> mov ecx,eax
> mov ebx,eax
> jecxz @@9
> @@1:
> lodsb
> cmp al,'a'
> jb @@2
> cmp al,'z'
> ja @@2
> sub al,'a'-'A'
> @@2:
> stosb
> loop @@1
> sub edi,ebx
> mov esi,Block
> mov ecx,Size
> jecxz @@8
> cld
> sub ecx,ebx
> jb @@8
> inc ecx
> @@4:
> mov ah,[edi]
> and ah,0DFh
> @@5:
> lodsb
> and al,0DFh
> cmp al,ah
> loopne @@5
> jne @@8
> dec esi
> mov edx,ecx
> mov ecx,ebx
> @@6:
> repe cmpsb
> je @@10
> mov al,[esi-1]
> cmp al,'a'
> jb @@7
> cmp al,'z'
> ja @@7
> sub al,'a'-'A'
> @@7:
> cmp al,[edi-1]
> je @@6
> sub ecx,ebx
> lea esi,[esi+ecx+1]
> add edi,ecx
> mov ecx,edx
> test ecx,ecx
> jne @@4
> @@8:
> xor eax,eax
> jmp @@11
> @@9:
> mov eax,1
> jmp @@11
> @@10:
> sub esi,ebx
> mov eax,esi
> sub eax,Block
> inc eax
> @@11:
> dec eax
736c715
< if (Longint(Location) <> Longint(ALocation)) or
> if (Location.X <> ALocation.X) or (Location.Y <> ALocation.Y) or
794c773
< function TEditor.BufChar(P: Word): Char; assembler;
> function TEditor.BufChar(P: Word): Char; assembler; {$USES None} {$FRAME-}
796,802c775,782
< LES DI,Self
> mov ecx,Self
> mov edx,P
> cmp edx,[ecx].TEditor.CurPtr
> jb @@1
> add edx,[ecx].TEditor.GapLen
> @@1:
> add edx,[ecx].TEditor.Buffer
> mov al,[edx]
805c785
< function TEditor.BufPtr(P: Word): Word; assembler;
> function TEditor.BufPtr(P: Word): Word; assembler; {$USES None} {$FRAME-}
807,812c787,792
< LES DI,Self
> mov ecx,Self
> mov eax,P
> cmp eax,[ecx].TEditor.CurPtr
> jb @@1
> add eax,[ecx].TEditor.GapLen
> @@1:
875d854
< ShiftState: Byte absolute $40:$17;
880c859
< if (ShiftState and $03 <> 0) and
> if (GetShiftState and $03 <> 0) and
953c932
< I := EditorDialog(edReplacePrompt, Pointer(C));
> I := EditorDialog(edReplacePrompt, @C);
997c976
< B: array[0..MaxLineLength - 1] of Word;
> B: array[0..MaxLineLength - 1] of SmallWord;
1028c1007
< Width: Integer; Colors: Word); assembler;
> Width: Integer; Colors: Word); assembler; {$USES ebx,esi,edi} {$FRAME+}
1030,1083c1009,1070
< PUSH DS
> mov ebx,Self
> mov edi,DrawBuf
> mov esi,LinePtr
> xor edx,edx
> cld
> mov ah,Colors.Byte[0]
> mov ecx,[ebx].TEditor.SelStart
> Call @@10
> mov ah,Colors.Byte[1]
> mov ecx,[ebx].TEditor.CurPtr
> Call @@10
> add esi,[ebx].TEditor.GapLen
> mov ecx,[ebx].TEditor.SelEnd
> add ecx,[ebx].TEditor.GapLen
> Call @@10
> mov ah,Colors.Byte[0]
> mov ecx,[ebx].TEditor.BufSize
> Call @@10
> jmp @@31
> @@10:
> sub ecx,esi
> ja @@11
> ret
> @@11:
> mov ebx,[ebx].TEditor.Buffer
> add esi,ebx
> mov ebx,Width
> @@12:
> lodsb
> cmp al,' '
> jb @@20
> @@13:
> stosw
> inc edx
> @@14:
> cmp edx,ebx
> jae @@30
> loop @@12
> mov ebx,Self
> sub esi,[ebx].TEditor.Buffer
> ret
> @@20:
> cmp al,0Dh
> je @@30
> cmp al,09h
> jne @@13
> mov al,' '
> @@21:
> stosw
> inc edx
> test dl,7
> jne @@21
> jmp @@14
> @@30:
> pop ecx
> @@31:
> mov al,' '
> mov ecx,Width
> sub ecx,edx
> jbe @@32
> rep stosw
> @@32:
1104d1090
< ShiftState: Byte absolute $40:$17;
1125c1111
< if Selecting or (ShiftState and $03 <> 0) then SelectMode := smExtend;
> if Selecting or (GetShiftState and $03 <> 0) then SelectMode := smExtend;
1256c1242
< if (NewSize > $FFF0) or not SetBufSize(NewSize) then
> if not SetBufSize(NewSize) then
1322c1308
< function TEditor.LineEnd(P: Word): Word; assembler;
> function TEditor.LineEnd(P: Word): Word; assembler; {$USES ebx,esi,edi} {$FRAME-}
1324,1347c1310,1335
< PUSH DS
> mov esi,Self
> mov ebx,[esi].TEditor.Buffer
> mov edi,P
> mov al,0Dh
> cld
> mov ecx,[esi].TEditor.CurPtr
> sub ecx,edi
> jbe @@1
> add edi,ebx
> repne scasb
> je @@2
> mov edi,[esi].TEditor.CurPtr
> @@1:
> mov ecx,[esi].TEditor.BufLen
> sub ecx,edi
> jecxz @@4
> add ebx,[esi].TEditor.GapLen
> add edi,ebx
> repne scasb
> jne @@3
> @@2:
> dec edi
> @@3:
> sub edi,ebx
> @@4:
> mov eax,edi
1375c1363
< function TEditor.LineStart(P: Word): Word; assembler;
> function TEditor.LineStart(P: Word): Word; assembler; {$USES ebx,esi,edi} {$FRAME-}
1377,1412c1365,1400
< PUSH DS
> mov esi,Self
> mov ebx,[esi].TEditor.Buffer
> mov edi,P
> mov al,0Dh
> std
> mov ecx,edi
> sub ecx,[esi].TEditor.CurPtr
> jbe @@1
> add ebx,[esi].TEditor.GapLen
> lea edi,[edi+ebx-1]
> repne scasb
> je @@2
> sub ebx,[esi].TEditor.GapLen
> mov edi,[esi].TEditor.CurPtr
> @@1:
> mov ecx,edi
> jecxz @@4
> lea edi,[edi+ebx-1]
> repne scasb
> jne @@3
> @@2:
> inc edi
> inc edi
> sub edi,ebx
> cmp edi,[esi].TEditor.CurPtr
> je @@4
> cmp edi,[esi].TEditor.BufLen
> je @@4
> cmp [ebx+edi].Byte,0Ah
> jne @@4
> inc edi
> jmp @@4
> @@3:
> xor edi,edi
> @@4:
> mov eax,edi
1433c1421
< function TEditor.NextChar(P: Word): Word; assembler;
> function TEditor.NextChar(P: Word): Word; assembler; {$USES ebx,esi,edi} {$FRAME-}
1435,1451c1423,1439
< PUSH DS
> mov esi,Self
> mov edi,P
> cmp edi,[esi].TEditor.BufLen
> je @@2
> inc edi
> cmp edi,[esi].TEditor.BufLen
> je @@2
> mov ebx,[esi].TEditor.Buffer
> cmp edi,[esi].TEditor.CurPtr
> jb @@1
> add ebx,[esi].TEditor.GapLen
> @@1:
> cmp [ebx+edi-1].Word,0A0Dh
> jne @@2
> inc edi
> @@2:
> mov eax,edi
1468c1456
< function TEditor.PrevChar(P: Word): Word; assembler;
> function TEditor.PrevChar(P: Word): Word; assembler; {$USES ebx,esi,edi} {$FRAME-}
1470,1485c1458,1473
< PUSH DS
> mov esi,Self
> mov edi,P
> test edi,edi
> je @@2
> dec edi
> je @@2
> mov ebx,[esi].TEditor.Buffer
> cmp edi,[esi].TEditor.CurPtr
> jb @@1
> add ebx,[esi].TEditor.GapLen
> @@1:
> cmp [ebx+edi-1].Word,0A0Dh
> jne @@2
> dec edi
> @@2:
> mov eax,edi
1569,1570c1557,1558
< Longint(CurPos) := 0;
> CurPos.X := 0; CurPos.Y := 0;
> Delta.X := 0; Delta.Y := 0;
1848c1836
< if Buffer <> nil then DisposeBuffer(Buffer);
> inherited DoneBuffer;
1887c1875
< if (FSize > $FFF0) or not SetBufSize(Word(FSize)) then
> if not SetBufSize(Word(FSize)) then
1956a1945
> P: Pointer;
1958a1948
> if NewSize > SizeOf(TEditBuffer) then Exit;
1960,1961c1950
< if NewSize > $F000 then NewSize := $FFF0 else
> NewSize := (NewSize + $0FFF) and $FFFF000;
1965c1954,1960
< if not SetBufferSize(Buffer, NewSize) then Exit;
> begin
> P := MemAlloc(NewSize);
> if P = nil then Exit;
> Move(Buffer^, P^, BufSize);
> FreeMem(Buffer, BufSize);
> Buffer := P;
> end;
1968c1963,1973
< if NewSize < BufSize then SetBufferSize(Buffer, NewSize);
> if NewSize < BufSize then
> begin
> P := MemAlloc(NewSize);
> if P = nil then NewSize := BufSize
> else
> begin
> Move(Buffer^, P^, BufSize);
> FreeMem(Buffer, BufSize);
> Buffer := P;
> end;
> end;
Comparing BP7\MEMORY.PAS and VP\MEMORY.PAS
13c13
< {$O+,F+,X+,I-,S-,Q-}
> {$X+,I-,S-,Q-}
16a17,18
> uses Use32;
>
18d19
< MaxHeapSize: Word = 655360 div 16; { 640K }
20d20
< MaxBufMem: Word = 65536 div 16; { 64K }
28d27
< function MemAllocSeg(Size: Word): Pointer;
36c35
< {$IFNDEF DPMI}
> { The following procedure is not implemented
38,40c37
< procedure GetBufMem(var P: Pointer; Size: Word);
> function MemAllocSeg(Size: Word): Pointer;
42c39
< {$ENDIF}
> }
48c45
< Ofs, Seg: Word;
> Ofs: Longint;
51,52d47
< {$IFDEF DPMI}
57a53,60
> Size: Word;
> Data: record end;
> end;
>
> PBuffer = ^TBuffer;
> TBuffer = record
> Next: PBuffer;
> Size: Word;
63a67
> BufferList: PBuffer = nil;
67,79d70
< function MemAllocateBlock(HeapHandle, Size, Attributes: Word;
101c92
< function HeapNotify(Size: Word): Integer; far;
> function HeapNotify(Size: Word): Integer;
149,161d139
< function MemAllocSeg(Size: Word): Pointer;
167,169c145
< PtrRec(Cache).Ofs := 0;
> if MaxAvail >= Size then GetMem(Cache,Size) else Cache := nil;
178a155
> Cache^.Size := Size;
189d165
< PtrRec(Cache).Seg := PtrRec(P).Seg;
200c176
< MemFreeBlock(PtrRec(Cache).Seg);
> FreeMem(Cache,Cache^.Size);
205,322d180
< begin
324c182
< P: Pointer;
> Buffer: PBuffer;
326,329c184,186
< HeapResult := 1;
> Inc(Size, SizeOf(TBuffer));
> Buffer := MemAlloc(Size);
> if Buffer <> nil then
331,332c188,191
< FreeMem(P, Size);
> Buffer^.Next := BufferList;
> Buffer^.Size := Size;
> BufferList := Buffer;
> Inc(PtrRec(Buffer).Ofs, SizeOf(TBuffer));
334c193
< MemAlloc := P;
> P := Buffer;
337c196
< function MemAllocSeg(Size: Word): Pointer;
> procedure DisposeBuffer(P: Pointer);
339c198
< P, T: Pointer;
> Buffer,PrevBuf: PBuffer;
341,342d199
< Size := (Size + 7) and $FFF8;
345c202,205
< if PtrRec(P).Ofs = 0 then
> Dec(PtrRec(P).Ofs, SizeOf(TBuffer));
> Buffer := BufferList;
> PrevBuf := nil;
> while (Buffer <> nil) and (P <> Buffer) do
347,349c207,210
< PtrRec(T).Ofs := Size and 15;
> PrevBuf := Buffer;
> Buffer := Buffer^.Next;
> end;
> if Buffer <> nil then
351,353c212,213
< T := P;
> if PrevBuf = nil then BufferList := Buffer^.Next else PrevBuf^.Next := Buffer^.Next;
> FreeMem(Buffer,Buffer^.Size);
355,511d214
< FreeMem(T, 8);
515,518c218
< procedure NewBuffer(var P: Pointer; Size: Word);
> function GetBufferSize(P: Pointer): Word;
520,521c220,221
< BufSize := (Size + 15) shr 4 + 1;
> if P = nil then GetBufferSize := 0
> else
523,527c223,224
< Buffer := Ptr(BufHeapPtr, 0);
> Dec(PtrRec(P).Ofs,SizeOf(TBuffer));
> GetBufferSize := PBuffer(P)^.Size;
531,542d227
< procedure DisposeBuffer(P: Pointer);
544,545d228
< var
547,548d229
< Dec(PtrRec(P).Seg);
550,565d230
< if BufHeapPtr + NewSize - GetBufSize(P) <= BufHeapEnd then
567,582d231
<
Comparing BP7\MENUS.PAS and VP\MENUS.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Views;
> uses Objects, Drivers, Views, Use32;
1126c1126
< if I + L < Size.X then
> if I + L - 1 < Size.X then { !!! -1 is added }
1135,1137c1135,1137
< MoveChar(B[I], ' ', Byte(Color), 1);
> {MoveChar(B[I], ' ', Byte(Color), 1); !!!! }
> MoveCStr(B[I], T^.Text^, Color); { [I+1] }
> MoveChar(B[I + L], ' ', Byte(CNormal), 1); { [I+L+1],' ',Byte(Color) }
1139c1139
< Inc(I, L + 2);
> Inc(I, L + 1); { L+2 }
1192c1192
< K := I + CStrLen(T^.Text^) + 2;
> K := I + CStrLen(T^.Text^) + 1; { !!! + 2 }
1222c1222
< Event.InfoPtr := nil;
> Event.InfoPtr := T;
Comparing BP7\MSGBOX.PAS and VP\MSGBOX.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-}
17c17
< uses Objects;
> uses Objects, Use32;
Comparing BP7\TEXTVIEW.PAS and VP\TEXTVIEW.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Views, Dos;
> uses Objects, Drivers, Views, Dos, Use32;
194c194
< procedure DecDi; near; assembler;
> procedure DecEDi; assembler; {$USES None} {$FRAME-}
196,199c196,200
< CMP DI,WORD PTR [SI].TTerminal.Buffer
> cmp edi,[esi].TTerminal.Buffer
> ja @@1
> add edi,[esi].TTerminal.BufSize
> @@1:
> dec edi
202c203
< procedure IncDi; near; assembler;
> procedure IncEDi; assembler; {$USES None} {$FRAME-}
204,210c205,211
< INC DI
> inc edi
> mov eax,[esi].TTerminal.Buffer
> add eax,[esi].TTerminal.BufSize
> cmp edi,eax
> jb @@1
> mov edi,[esi].TTerminal.Buffer
> @@1:
212a214,215
> {$USES esi,edi} {$FRAME-}
>
217,257c220,266
< PUSH DS
> mov esi,Self
> mov edi,[esi].TTerminal.Buffer
> add edi,Pos
> @@1:
> mov ecx,Lines
> jecxz @@6
> mov eax,[esi].TTerminal.QueBack
> add eax,[esi].TTerminal.Buffer
> cmp edi,eax
> je @@7
> Call DecEDI
> @@2:
> mov eax,[esi].TTerminal.QueBack
> add eax,[esi].TTerminal.Buffer
> cmp edi,eax
> ja @@3
> mov ecx,edi
> sub ecx,[esi].TTerminal.Buffer
> jmp @@4
> @@3:
> mov ecx,edi
> sub ecx,eax
> @@4:
> mov al,LineSeparator
> inc ecx
> std
> repne scasb
> je @@5
> mov eax,edi
> sub eax,[esi].TTerminal.Buffer
> inc eax
> cmp eax,[esi].TTerminal.QueBack
> je @@8
> mov edi,[esi].TTerminal.Buffer
> add edi,[esi].TTerminal.BufSize
> dec edi
> jmp @@2
> @@5:
> dec Lines
> jnz @@2
> @@6:
> Call IncEDI
> Call IncEDI
> mov eax,edi
> @@7:
> sub eax,[esi].TTerminal.Buffer
> @@8:
324c333
< Filler: Array [1..12] of Char;
> Filler: array [1..4] of Char;
384c393
< Handle := $FFFF;
> Handle := $FFFFFFFF;
Comparing BP7\DIALOGS.PAS and VP\DIALOGS.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Views, Validate;
> uses Objects, Drivers, Views, Validate, Use32;
633,641d632
< function Max(A, B: Integer): Integer;
1354,1372c1345,1349
< function TCluster.ButtonState(Item: Integer): Boolean; assembler;
> function TCluster.ButtonState(Item: Integer): Boolean;
> begin
> if Item > 31
> then ButtonState := False
> else ButtonState := ((1 shl Item) and EnableMask) <> 0;
1585,1613c1562,1581
< procedure TCluster.SetButtonState(AMask: Longint; Enable: Boolean); assembler;
> procedure TCluster.SetButtonState(AMask: Longint; Enable: Boolean);
> var
> I,M: Longint;
> begin
> if Enable then EnableMask := EnableMask or AMask
> else EnableMask := EnableMask and not AMask;
> if Strings.Count <= 32 then
> begin
> M := 1;
> for I := 1 to Strings.Count do
> begin
> if (M and EnableMask) <> 0 then
> begin
> Options := Options or ofSelectable;
> Exit;
> end;
> M := M shl 1;
> end;
> Options := Options and not ofSelectable;
> end;
Comparing BP7\HISTLIST.PAS and VP\HISTLIST.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
18,21c18,21
< Byte Byte String Byte Byte String
> Longint String StrLen Longint String StrLen
> +----------------------------+----------------------------+--...--+
> | Id | History string | L | Id | History string | L |
> +----------------------------+----------------------------+--...--+
27c27
< uses Objects;
> uses Objects, Use32;
31c31
< HistorySize: Word = 1024;
> HistorySize: Word = 2*1024;
34,36c34,36
< procedure HistoryAdd(Id: Byte; const Str: String);
> procedure HistoryAdd(Id: Longint; const Str: String);
> function HistoryCount(Id: Longint): Word;
> function HistoryStr(Id: Longint; Index: Integer): String;
48c48
< CurId: Byte;
> CurId: Longint;
53c53
< procedure AdvanceStringPointer; near; assembler;
> procedure AdvanceStringPointer; assembler; {$USES esi} {$FRAME-}
55,77c55,77
< PUSH DS
> mov ecx,HistoryUsed
> mov edx,CurId
> mov esi,CurString
> test esi,esi
> jz @@4
> cld
> cmp esi,HistoryBlock
> jne @@2
> cmp esi,ecx
> je @@3
> @@1:
> lodsd { History Id }
> cmp eax,edx { edx = CurId }
> je @@4
> @@2:
> movzx eax,Byte Ptr [esi]
> lea esi,[esi+eax+2]
> cmp esi,ecx { ecx = HistoryUsed }
> jb @@1
> @@3:
> xor esi,esi
> @@4:
> mov CurString,esi
82c82
< procedure DeleteString; near; assembler;
> procedure DeleteString; assembler; {$USES esi,edi} {$FRAME-}
84,100c84,92
< PUSH DS
> cld
> mov ecx,HistoryUsed
> mov esi,CurString
> lea edi,[esi-TYPE Longint]
> movzx eax,Byte Ptr [esi]
> lea esi,[esi+eax+2]
> sub ecx,esi
> rep movsb
> mov HistoryUsed,edi
105c97
< procedure InsertString(Id: Byte; const Str: String); near; assembler;
> procedure InsertString(Id: Longint; const Str: String); assembler; {$USES ebx,esi,edi} {$FRAME-}
107,160c99,139
< PUSH DS
> { Position edi to the end the buffer }
> { edx to beginning of buffer }
> mov edx,HistoryBlock
> mov edi,HistoryUsed
> mov esi,Str
> movzx ebx,Byte Ptr [esi]
> add ebx,TYPE Longint + TYPE Byte + TYPE Byte
> @@1:
> mov eax,edi
> add eax,ebx
> sub eax,edx { edx = HistoryBlock }
> cmp eax,HistorySize
> jb @@2
> { Drop the last string off the end of the list }
> movzx eax,Byte Ptr [edi-1] { Last string length }
> sub edi,eax
> sub edi,TYPE Longint + TYPE Byte + TYPE Byte
> jmp @@1
> { Move the table down the size of the string }
> @@2:
> std
> mov esi,edi
> add edi,ebx
> mov HistoryUsed,edi
> mov ecx,esi
> sub ecx,edx { edx = HistoryBlock }
> dec esi
> dec edi
> rep movsb
> { Copy the string into the position }
> cld
> mov edi,edx { edx = HistoryBlock }
> mov eax,Id
> stosd { Id }
> mov esi,Str
> xor eax,eax
> lodsb
> stosb { StrLen }
> mov ecx,eax
> rep movsb { String }
> stosb { StrLen }
163c142
< procedure StartId(Id: Byte); near;
> procedure StartId(Id: Longint);
169c148
< function HistoryCount(Id: Byte): Word;
> function HistoryCount(Id: Longint): Word;
184c163
< procedure HistoryAdd(Id: Byte; const Str: String);
> procedure HistoryAdd(Id: Longint; const Str: String);
201c180
< function HistoryStr(Id: Byte; Index: Integer): String;
> function HistoryStr(Id: Longint; Index: Integer): String;
214,215c193
< PChar(HistoryBlock)^ := #0;
> HistoryUsed := Longint(HistoryBlock);
222c200
< Size := HistoryUsed - PtrRec(HistoryBlock).Ofs;
> Size := HistoryUsed - Longint(HistoryBlock);
233c211
< HistoryUsed := PtrRec(HistoryBlock).Ofs + Size;
> HistoryUsed := Longint(HistoryBlock) + Size;
Comparing BP7\OUTLINE.PAS and VP\OUTLINE.PAS
13c13
< {$O+,F+,X+,I-,S-,R-}
> {$X+,I-,S-,R-,Cdecl-}
17c17
< uses Objects, Drivers, Views;
> uses Objects, Drivers, Views, Use32;
289c289
< const Chars: String): String; assembler;
> const Chars: String): String; assembler; {$USES ebx,esi,edi} {$FRAME-}
298,299c298
< PUSH DS
> cld
302,312c301,311
< XOR BX,BX
> xor ebx,ebx
> mov eax,Flags
> mov Expanded,bl
> shr eax,1
> adc Expanded,bl
> mov Children,bl
> shr eax,1
> adc Children,bl
> mov Last,bl
> shr eax,1
> adc Last,bl
315,321c314,319
< LDS SI,Chars
> mov esi,Chars
> inc esi
> mov edi,@Result
> inc edi
> mov edx,Lines
> inc Level
324,338c322,335
< JMP @@2
> jmp @@2
> @@1:
> xor ebx,ebx
> shr edx,1
> rcl ebx,1
> mov al,[esi].FillerOrBar[ebx]
> stosb
> mov al,[esi].FillerOrBar
> mov ecx,LevWidth
> dec ecx
> rep stosb
> @@2:
> dec Level
> jnz @@1
341,365c338,362
< MOV BH,0
> mov ecx,EndWidth
> dec ecx
> jz @@4
> mov bl,Last
> mov al,[esi].YorL[ebx]
> stosb
> dec ecx
> jz @@4
> dec ecx
> jz @@3
> mov al,[esi].StraightOrTee
> rep stosb
> @@3:
> mov bl,Children
> mov al,[esi].StraightOrTee[ebx]
> stosb
> @@4:
> mov bl,Expanded
> mov al,[esi].Retracted[ebx]
> stosb
> mov eax,edi
> mov edi,@Result
> sub eax,edi
> dec eax
> stosb
370,373c367,370
< function CallerFrame: Word; inline(
> function CallerFrame: Word; assembler; {$USES None} {$FRAME-}
> asm
> mov eax,[ebp]
> end;
403c400
< { Called whenever Node is receives focus }
> { Called whenever Node receives focus }
521,522d517
< label
527c522
< Children: Boolean;
> Children,Done: Boolean;
541a537,544
> { IMPORTANT! Virtual Pascal's code generation differs from BP's one.}
> { In the prolog of a nested procedure Virtual Pascal uses 'ENTER' }
> { CPU instruction with the appropriate lexical (nested) level. }
> { Exact lexical level of a procedure that issues FirstThat or }
> { ForEach is NOT known here. So I made an assumption that FirstThat }
> { or ForEach CANNOT BE ISSUED FROM THE PROCEDURE WITH THE LEXICAL }
> { LEVEL GREATER THAN 3. For example, FirstThat function is called }
> { in a GetFocusedGraphic function which lexical level is 2. }
543,557c546,568
< LES DI,Cur { Push Cur }
> push DWord Ptr [ebp-12] { Preserve local variables }
> push DWord Ptr [ebp-8]
> mov ecx,[ebp-4] { Load parent frame into ecx }
> push ecx { Save it on stack }
> push Cur { [1] = Cur: Pointer; }
> push Level { [2] = Level: Integer; }
> push DWord Ptr [ecx+OFFSET Position] { [3] = Position: Integer; }
> push Lines { [4] = Lines: LongInt; }
> push Flags { [5] = Flags: Word; }
> mov edx,[ecx+OFFSET CallerFrame]
> mov eax,[edx-4] { Copy stack frames of the }
> mov [ebp-4],eax { parents }
> mov eax,[edx-8]
> mov [ebp-8],eax
> mov eax,[edx-12]
> mov [ebp-12],eax
> Call DWord Ptr [ecx+OFFSET Action]
> pop ecx
> pop DWord Ptr [ebp-8]
> pop DWord Ptr [ebp-12]
> mov [ebp-4],ecx { Restore parent frame }
> and al,[ecx+OFFSET CheckRslt].Boolean { Force to 0 if CheckRslt False }
> setnz Done
559a571,572
> if Done then Exit;
>
574d586
< Retn:
580c592
< asm { Convert 0, 1 to 0, FF }
> asm {$SAVES ALL} { Convert 0, 1 to 0, FF }
877c889
<
>
Comparing BP7\STDDLG.PAS and VP\STDDLG.PAS
13c13
< {$O+,F+,V-,X+,I-,S-}
> {$V-,X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Views, Dialogs, Dos;
> uses Objects, Drivers, Views, Dialogs, Os2Def, Os2Base, Dos, Use32;
27c27
< cmChDir = 804; { Used by TChDirDialog internally }
> cmChangeDir = 804; { Used by TChDirDialog internally }
46c46
< Name: string[12];
> Name: String;
101c101
< procedure ReadDirectory(AWildCard: PathStr);
> procedure ReadDirectory(AWildCard: PathStr); virtual;
152d151
< private
213d211
< private
295a294,296
> function PathValid(var Path: PathStr): Boolean; { !!! made public }
> function IsWild(const S: String): Boolean; { !!! made public }
> function IsDir(const S: String): Boolean; { !!! made public }
301,319c302,308
< function DriveValid(Drive: Char): Boolean; near; assembler;
> function DriveValid(Drive: Char): Boolean;
> var
> DriveNum,LogDrvMap: ULong;
> begin { LogDrvMap: Bit 0: 'A:', Bit 1: 'B:', etc }
> if DosQueryCurrentDisk(DriveNum,LogDrvMap) = 0
> then DriveValid := ((1 shl (Ord(Drive) - Ord('A'))) and LogDrvMap) <> 0
> else DriveValid := False;
333a323
> FindClose(SR);
339c329
< IllegalChars = ';,=+<>|"[] \';
> IllegalChars = ';,=+<>|"[] ';
346c336
< function Contains(S1, S2: String): Boolean; near; assembler;
> function Contains(S1, S2: String): Boolean; assembler; {$USES esi,edi}{$FRAME-}
348,371c338,363
< PUSH DS
> cld
> xor eax,eax
> xor ecx,ecx
> mov esi,S1
> mov edx,S2
> lodsb
> test al,al
> jz @@4
> mov ah,al
> mov cl,[edx]
> inc edx
> @@1:
> push ecx
> mov edi,edx
> lodsb
> repne scasb
> pop ecx
> je @@3
> dec ah
> jnz @@1
> @@2:
> xor al,al
> jmp @@4
> @@3:
> mov al,1
> @@4:
393c385
<
>
409a402
> FindClose(SR);
677a671
> FindClose(S);
692a687
> FindClose(S);
708a704
> FindClose(S);
752c748
< Month: array[1..12] of String[3] =
> Month: array[1..12] of String[3] =
950c946
< function NoWildChars(S: String): String; near; assembler;
> function NoWildChars(S: String): String; assembler; {$USES esi,edi} {$FRAME-}
952,972c948,968
< PUSH DS
> mov esi,S
> xor eax,eax
> lodsb
> mov ecx,eax
> mov edx,@Result
> lea edi,[edx+1]
> jecxz @@3
> @@1:
> lodsb
> cmp al,'?'
> je @@2
> cmp al,'*'
> je @@2
> stosb
> @@2:
> loop @@1
> @@3:
> mov eax,edi
> sub eax,edx
> dec eax
> mov [edx],al
1076,1078c1072,1074
< Directory := NewSTr(FName+'\');
> Directory := NewSTr(FName+'\');
> if Command <> cmFileInit then FileList^.Select;
> FileList^.ReadDirectory(Directory^+WildCard);
1179c1175
< function NewDirEntry(const DisplayText, Directory: String): PDirEntry; near;
> function NewDirEntry(const DisplayText, Directory: String): PDirEntry;
1189,1193c1185,1190
< function GetCurDrive: Char; near; assembler;
> function GetCurDrive: Char;
> var
> DriveNum,LogDrvMap: ULong;
> begin
> DosQueryCurrentDisk(DriveNum,LogDrvMap); { DriveNum: 1='A', 2='B', etc }
> GetCurDrive := Chr(DriveNum + Ord('A') - 1);
1209c1206
< begin
> begin
1211,1212c1208,1209
< begin
> begin
> S := FirstDir + OldC;
1216c1213
< AList^.Insert(NewDirEntry(S, OldC + ':\'));
> AList^.Insert(NewDirEntry(S, OldC + ':\'));
1259,1262c1256,1259
< begin
> begin
> S := FirstDir;
> isFirst := False;
> end else S := MiddleDir;
1266a1264
> FindClose(SR);
Comparing BP7\VIEWS.PAS and VP\VIEWS.PAS
13c13
< {$O+,F+,X+,I-,S-}
> {$X+,I-,S-,Cdecl-}
17c17
< uses Objects, Drivers, Memory;
> uses Objects, Drivers, Memory, Use32;
192c192
< TDrawBuffer = array[0..MaxViewWidth - 1] of Word;
> TDrawBuffer = array[0..MaxViewWidth - 1] of SmallWord;
423c423
< TVideoBuf = array[0..3999] of Word;
> TVideoBuf = array[0..3999] of SmallWord;
621a622,623
> uses Os2Def, Os2Base;
>
642a645,663
> { Far16 functions cannot be called directly from BASM code because Virtual }
> { Pascal calls 16-bit functions via special run-time library thunk routine. }
> { That is why these interface function are used instead. }
>
> function Vio32ShowBuf(BufOfs,Len,VioHandle: Word): ApiRet;
> begin
> VioShowBuf(BufOfs,Len,VioHandle);
> end;
>
> function Vio32SetCurPos(Row,Column: Word; VioHandle: Word): ApiRet;
> begin
> VioSetCurPos(Row,Column,VioHandle);
> end;
>
> function Vio32SetCurType(var CurData: VioCursorInfo; VioHandle: Word): ApiRet;
> begin
> VioSetCurType(CurData,VioHandle);
> end;
>
647c668
< procedure MapColor; near; assembler;
> procedure MapColor; assembler; {$USES ebx} {$FRAME-}
649c670
< Self = 6;
> Self = 8;
652,681c673,698
< OR AL,AL
> test al,al
> jz @@3
> mov ecx,[ebp].Self
> @@1:
> push ecx
> push eax
> push ecx { [1]:Pointer = Self }
> mov ecx,[ecx]
> Call DWord Ptr [ecx].TView_GetPalette
> mov ebx,eax
> pop eax
> pop ecx
> test ebx,ebx
> jz @@2
> cmp al,[ebx]
> ja @@3
> xlat
> test al,al
> jz @@3
> @@2:
> mov ecx,[ecx].TView.Owner
> jecxz @@4
> jmp @@1
> @@3:
> mov al,ErrorAttr
> @@4:
688c705
< procedure MapCPair; near; assembler;
> procedure MapCPair; assembler; {$USES None} {$FRAME-}
690,695c707,713
< OR AH,AH
> test ah,ah
> jz @@1
> xchg al,ah
> Call MapColor
> xchg al,ah
> @@1:
> Call MapColor
699,702c717,720
< { In AX = Y coordinate }
> { In eax = Y coordinate }
> { ebx = X coordinate }
> { ecx = Count }
> { edi = Buffer Pointer }
704c722
< procedure WriteView; near; assembler;
> procedure WriteView; assembler; {$USES None} {$FRAME-}
706c724
< Self = 6;
> Self = 8;
709c727
< BufOfs = -10;
> BufOfs = -12;
711,937c729,935
< MOV [BP].BufOfs,BX
> mov [ebp].BufOfs,ebx
> mov [ebp].Buffer[0],edi
> add ecx,ebx
> xor edx,edx { edx = Flag (0:Char&Attr,1:Char only) }
> mov edi,[ebp].Self
> test eax,eax
> jl @@3
> cmp eax,[edi].TView.Size.Y
> jge @@3
> test ebx,ebx
> jge @@1
> xor ebx,ebx
> @@1:
> cmp ecx,[edi].TView.Size.X
> jle @@2
> mov ecx,[edi].TView.Size.X
> @@2:
> cmp ebx,ecx
> jl @@10
> @@3:
> ret
>
> @@10:
> test [edi].TView.State,sfVisible
> jz @@3
> cmp [edi].TView.Owner,0
> jz @@3
> mov [ebp].Target,edi
> add eax,[edi].TView.Origin.Y
> mov esi,[edi].TView.Origin.X
> add ebx,esi
> add ecx,esi
> add [ebp].BufOfs,esi
> mov edi,[edi].TView.Owner
> cmp eax,[edi].TGroup.Clip.A.Y
> jl @@3
> cmp eax,[edi].TGroup.Clip.B.Y
> jge @@3
> cmp ebx,[edi].TGroup.Clip.A.X
> jge @@11
> mov ebx,[edi].TGroup.Clip.A.X
> @@11:
> cmp ecx,[edi].TGroup.Clip.B.X
> jle @@12
> mov ecx,[edi].TGroup.Clip.B.X
> @@12:
> cmp ebx,ecx
> jge @@3
> mov edi,[edi].TGroup.Last
> @@20:
> mov edi,[edi].TView.Next
> cmp edi,[ebp].Target
> je @@40
> test [edi].TView.State,sfVisible
> jz @@20
> mov esi,[edi].TView.Origin.Y
> cmp eax,esi
> jl @@20
> add esi,[edi].TView.Size.Y
> cmp eax,esi
> jl @@23
> test [edi].TView.State,sfShadow
> jz @@20
> add esi,ShadowSize.Y
> cmp eax,esi
> jge @@20
> mov esi,[edi].TView.Origin.X
> add esi,ShadowSize.X
> cmp ebx,esi
> jge @@22
> cmp ecx,esi
> jle @@20
> Call @@30
> @@22:
> add esi,[edi].TView.Size.X
> jmp @@26
> @@23:
> mov esi,[edi].TView.Origin.X
> cmp ebx,esi
> jge @@24
> cmp ecx,esi
> jle @@20
> Call @@30
> @@24:
> add esi,[edi].TView.Size.X
> cmp ebx,esi
> jge @@25
> cmp ecx,esi
> jle @@31
> mov ebx,esi
> @@25:
> test [edi].TView.State,sfShadow
> je @@20
> push esi
> mov esi,[edi].TView.Origin.Y
> add esi,ShadowSize.Y
> cmp eax,esi
> pop esi
> jl @@27
> add esi,ShadowSize.X
> @@26:
> cmp ebx,esi
> jge @@27
> inc edx
> cmp ecx,esi
> jle @@27
> Call @@30
> dec edx
> @@27:
> jmp @@20
>
> @@30:
> push DWord Ptr [ebp].Target
> push DWord Ptr [ebp].BufOfs
> push edi
> push esi
> push edx
> push ecx
> push eax
> mov ecx,esi
> Call @@20
> pop eax
> pop ecx
> pop edx
> pop esi
> pop edi
> pop DWord Ptr [ebp].BufOfs
> pop DWord Ptr [ebp].Target
> mov ebx,esi
> @@31:
> ret
>
> @@40:
> mov edi,[edi].TView.Owner
> mov esi,[edi].TGroup.Buffer
> test esi,esi
> jz @@44
> cmp esi,ScreenBuffer
> jne @@43
> Call UpdateMouseWhere
> cmp eax,MouseWhere.Y
> jne @@43
> cmp ebx,MouseWhere.X
> ja @@43
> cmp ecx,MouseWhere.X
> jbe @@43
> Call HideMouse
> Call @@50
> Call ShowMouse
> jmp @@44
> @@43:
> Call @@50
> @@44:
> cmp [edi].TGroup.LockFlag,0
> jne @@31
> jmp @@10
>
> { Copy to Buffer }
>
> @@50:
> push edi
> push ecx
> push ebx
> push eax
> mul [edi].TView.Size.X.Byte[0]
> add eax,ebx
> lea edi,[esi+eax*2]
> xor al,al
> mov ah,ShadowAttr
> sub ecx,ebx
> xchg esi,ebx
> sub esi,[ebp].BufOfs
> shl esi,1
> add esi,[ebp].Buffer
> push edi
> push ecx
> cld
> test edx,edx
> jnz @@52
> shr ecx,1
> rep movsd
> adc ecx,ecx
> rep movsw
> jmp @@53
> @@52:
> lodsb
> inc esi
> stosw
> loop @@52
> @@53:
> pop ecx
> pop edi
> mov eax,ScreenBuffer
> cmp ebx,eax
> jne @@54
> shl ecx,1
> sub edi,eax
> push edi { [1]:DWord = Offset }
> push ecx { [2]:DWord = Length }
> push 0 { [3]:DWord = Handle }
> Call Vio32ShowBuf
> @@54:
> pop eax
> pop ebx
> pop ecx
> pop edi
> ret
1222c1220
< procedure TView.GetBounds(var Bounds: TRect); assembler;
> procedure TView.GetBounds(var Bounds: TRect); assembler; {$USES esi,edi}{$FRAME-}
1224,1241c1222,1237
< PUSH DS
> mov esi,Self
> add esi,OFFSET TView.Origin
> mov edi,Bounds
> cld
> lodsd {Origin.X}
> mov ecx,eax
> stosd
> lodsd {Origin.Y}
> mov edx,eax
> stosd
> lodsd {Size.X}
> add eax,ecx
> stosd
> lodsd {Size.Y}
> add eax,edx
> stosd
1249c1245
< function TView.Exposed: Boolean; assembler;
> function TView.Exposed: Boolean; assembler; {$USES ebx,esi,edi} {$FRAME+}
1253,1353c1249,1354
< LES DI,Self
> mov edi,Self
> test [edi].TView.State,sfExposed
> je @@2
> xor eax,eax
> cmp eax,[edi].TView.Size.X
> jge @@2
> cmp eax,[edi].TView.Size.Y
> jge @@2
> @@1:
> xor ebx,ebx
> mov ecx,[edi].TView.Size.X
> push eax
> Call @@11
> pop eax
> jnc @@3
> mov edi,Self
> inc eax
> cmp eax,[edi].TView.Size.Y
> jl @@1
> @@2:
> mov al,0
> jmp @@30
> @@3:
> mov al,1
> jmp @@30
>
> @@8:
> stc
> @@9:
> ret
>
> @@10:
> mov edi,[edi].TView.Owner
> cmp [edi].TGroup.Buffer,0
> jne @@9
> @@11:
> mov Target,edi
> add eax,[edi].TView.Origin.Y
> mov esi,[edi].TView.Origin.X
> add ebx,esi
> add ecx,esi
> mov edi,[edi].TView.Owner
> test edi,edi
> jz @@9
> cmp eax,[edi].TGroup.Clip.A.Y
> jl @@8
> cmp eax,[edi].TGroup.Clip.B.Y
> jge @@8
> cmp ebx,[edi].TGroup.Clip.A.X
> jge @@12
> mov ebx,[edi].TGroup.Clip.A.X
> @@12:
> cmp ecx,[edi].TGroup.Clip.B.X
> jle @@13
> mov ecx,[edi].TGroup.Clip.B.X
> @@13:
> cmp ebx,ecx
> jge @@8
> mov edi,[edi].TGroup.Last
> @@20:
> mov edi,[edi].TView.Next
> cmp edi,Target
> je @@10
> test [edi].TView.State,sfVisible
> jz @@20
> mov esi,[edi].TView.Origin.Y
> cmp eax,esi
> jl @@20
> add esi,[edi].TView.Size.Y
> cmp eax,esi
> jge @@20
> mov esi,[edi].TView.Origin.X
> cmp ebx,esi
> jl @@22
> add esi,[edi].TView.Size.X
> cmp ebx,esi
> jge @@20
> mov ebx,esi
> cmp ebx,ecx
> jl @@20
> stc
> ret
> @@22:
> cmp ecx,esi
> jle @@20
> add esi,[edi].TView.Size.X
> cmp ecx,esi
> jg @@23
> mov ecx,[edi].TView.Origin.X
> jmp @@20
> @@23:
> push Target
> push edi
> push esi
> push ecx
> push eax
> mov ecx,[edi].TView.Origin.X
> Call @@20
> pop eax
> pop ecx
> pop ebx
> pop edi
> pop Target
> jc @@20
> retn
> @@30:
1385c1386
< function TView.GetColor(Color: Word): Word; assembler;
> function TView.GetColor(Color: Word): Word; assembler; {$USES None} {$FRAME+}
1387,1388c1388,1389
< MOV AX,Color
> mov eax,Color
> Call MapCPair
1405c1406
< procedure TView.GetExtent(var Extent: TRect); assembler;
> procedure TView.GetExtent(var Extent: TRect); assembler; {$USES esi,edi}{$FRAME-}
1407,1417c1408,1416
< PUSH DS
> mov esi,Self
> add esi,OFFSET TView.Size
> mov edi,Extent
> cld
> xor eax,eax
> stosd
> stosd
> movsd
> movsd
1519a1519,1520
> {$USES None} {$FRAME-}
>
1522,1537c1523,1536
< LES DI,Self
> mov ecx,Self
> xor eax,eax
> mov edx,eax
> @@1:
> add eax,[ecx].TView.Origin.X
> add edx,[ecx].TView.Origin.Y
> mov ecx,[ecx].TView.Owner
> test ecx,ecx
> jnz @@1
> add eax,Source.X
> add edx,Source.Y
> mov ecx,Dest
> mov [ecx].TPoint.X,eax
> mov [ecx].TPoint.Y,edx
1539a1539,1540
> {$USES None} {$FRAME-}
>
1542,1559c1543,1558
< LES DI,Self
> mov ecx,Self
> xor eax,eax
> mov edx,eax
> @@1:
> add eax,[ecx].TView.Origin.X
> add edx,[ecx].TView.Origin.Y
> mov ecx,[ecx].TView.Owner
> test ecx,ecx
> jnz @@1
> neg eax
> neg edx
> add eax,Source.X
> add edx,Source.Y
> mov ecx,Dest
> mov [ecx].TPoint.X,eax
> mov [ecx].TPoint.Y,edx
1595c1594
< function TView.Prev: PView; assembler;
> function TView.Prev: PView; assembler; {$USES None} {$FRAME-}
1597,1607c1596,1602
< LES DI,Self
> mov edx,Self
> mov ecx,edx
> @@1:
> mov eax,edx
> mov edx,[edx].TView.Next
> cmp edx,ecx
> jne @@1
1635c1630
<
>
1665c1660,1662
< procedure TView.ResetCursor; assembler;
> procedure TView.ResetCursor; assembler; {$USES esi,edi} {$FRAME-}
> const
> CurData: VioCursorInfo = (yStart: 0; cEnd: 0; cx: 1; attr: 0);
1667,1730c1664,1738
< LES DI,Self
> mov edi,Self
> mov eax,[edi].TView.State
> not eax
> test eax,sfVisible+sfCursorVis+sfFocused
> jne @@Hide
> mov eax,[edi].TView.Cursor.Y
> mov edx,[edi].TView.Cursor.X
> @@1:
> test eax,eax
> jl @@Hide
> cmp eax,[edi].TView.Size.Y
> jge @@Hide
> test edx,edx
> jl @@Hide
> cmp edx,[edi].TView.Size.X
> jge @@Hide
> add eax,[edi].TView.Origin.Y
> add edx,[edi].TView.Origin.X
> mov ecx,edi
> mov edi,[edi].TView.Owner
> test edi,edi
> jz @@Show
> test [edi].TView.State,sfVisible
> je @@Hide
> mov edi,[edi].TGroup.Last
> @@2:
> mov edi,[edi].TView.Next
> cmp ecx,edi
> jne @@3
> mov edi,[edi].TView.Owner
> jmp @@1
> @@3:
> test [edi].TView.State,sfVisible
> je @@2
> mov esi,[edi].TView.Origin.Y
> cmp eax,esi
> jl @@2
> add esi,[edi].TView.Size.Y
> cmp eax,esi
> jge @@2
> mov esi,[edi].TView.Origin.X
> cmp edx,esi
> jl @@2
> add esi,[edi].TView.Size.X
> cmp edx,esi
> jge @@2
> @@Hide:
> xor eax,eax
> dec eax { Color = -1: Invisible }
> xor ecx,ecx
> jmp @@4
> { Set Cursor Position }
> @@Show:
> push eax { [1]:DWord = Row }
> push edx { [2]:DWord = Column }
> push 0 { [3]:Word = Handle }
> Call Vio32SetCurPos
> { Set Cursor Shape }
> xor eax,eax { Color: Visible }
> mov cx,CursorLines
> mov edi,Self
> test [edi].TView.State,sfCursorIns
> jz @@4
> mov ch,1
> test cl,cl
> jne @@4
> mov cl,7
> @@4:
> lea edx,CurData
> mov [edx].VioCursorInfo.attr,ax
> mov [edx].VioCursorInfo.yStart.Byte,ch
> mov [edx].VioCursorInfo.cEnd.Byte,cl
> push edx { [1]:Pointer= @CurData }
> push 0 { [2]:DWord = Handle }
> Call Vio32SetCurType
1740c1748
< procedure TView.SetBounds(var Bounds: TRect); assembler;
> procedure TView.SetBounds(var Bounds: TRect); assembler; {$USES None} {$FRAME-}
1742,1755c1750,1761
< PUSH DS
> mov edx,Self
> mov ecx,Bounds
> mov eax,[ecx].TRect.A.X
> mov [edx].Origin.X,eax
> mov eax,[ecx].TRect.A.Y
> mov [edx].Origin.Y,eax
> mov eax,[ecx].TRect.B.X
> sub eax,[ecx].TRect.A.X
> mov [edx].Size.X,eax
> mov eax,[ecx].TRect.B.Y
> sub eax,[ecx].TRect.A.Y
> mov [edx].Size.Y,eax
1824,1827c1830,1837
< Longint(Min) := 0;
> Min.X := 0;
> Min.Y := 0;
> if Owner <> nil then Max := Owner^.Size
> else
> begin
> Max.X := MaxLongint;
> Max.Y := MaxLongint;
> end;
1860a1871,1872
> {$USES ebx,esi,edi} {$FRAME+}
>
1867,1880c1879,1893
< CMP H,0
> cmp H,0
> jle @@2
> @@1:
> mov eax,Y
> mov ebx,X
> mov ecx,W
> mov edi,Buf
> Call WriteView
> mov eax,W
> shl eax,1
> add Buf,eax
> inc Y
> dec H
> jnz @@1
> @@2:
1882a1896,1897
> {$USES ebx,esi,edi} {$FRAME+}
>
1890,1914c1905,1937
< MOV AL,Color
> mov al,Color
> Call MapColor
> mov ah,al
> mov al,C
> mov ecx,Count
> test ecx,ecx
> jle @@2
> cmp ecx,256
> jle @@1
> mov ecx,256
> @@1:
> lea ebx,[ecx*2+2]
> and ebx,NOT 11b
> sub esp,ebx
> mov edi,esp
> mov edx,eax
> shl eax,16
> mov ax,dx
> mov edx,ecx
> cld
> shr ecx,1
> rep stosd
> adc ecx,ecx
> rep stosw
> mov ecx,edx
> mov edi,esp
> mov eax,Y
> push ebx
> mov ebx,X
> Call WriteView
> pop eax
> add esp,eax
> @@2:
1916a1940,1941
> {$USES ebx,esi,edi} {$FRAME+}
>
1923,1933c1948,1959
< CMP H,0
> cmp H,0
> jle @@2
> @@1:
> mov eax,Y
> mov ebx,X
> mov ecx,W
> mov edi,Buf
> Call WriteView
> inc Y
> dec H
> jne @@1
> @@2:
1935a1962,1963
> {$USES ebx,esi,edi} {$FRAME+}
>
1942,1970c1970,1996
< MOV AL,Color
> mov al,Color
> Call MapColor
> mov ah,al
> mov esi,Str
> xor ecx,ecx
> cld
> lodsb
> mov cl,al
> jecxz @@2
> lea ebx,[ecx*2+2]
> and ebx,NOT 11b
> sub esp,ebx
> mov edi,esp
> mov edx,ecx
> @@1:
> lodsb
> stosw
> loop @@1
> mov ecx,edx
> mov edi,esp
> mov eax,Y
> push ebx
> mov ebx,X
> Call WriteView
> pop eax
> add esp,eax
> @@2:
1983c2009
< Color: Byte); assembler;
> Color: Byte); assembler; {$USES ebx,esi,edi} {$FRAME-}
1993,2065c2019,2093
< LES BX,Self
> mov ebx,Self
> mov edx,[ebx].TFrame.Size.X
> lea ecx,[edx-2]
> mov esi,OFFSET InitFrame
> add esi,N
> lea edi,FrameMask
> cld
> movsb
> lodsb
> rep stosb
> movsb
> mov ebx,[ebx].TFrame.Owner
> mov ebx,[ebx].TGroup.Last
> dec edx
> @@1:
> mov ebx,[ebx].TView.Next
> cmp ebx,Self
> je @@10
> @@2:
> test [ebx].TView.Options,ofFramed
> je @@1
> test [ebx].TView.State,sfVisible
> je @@1
> mov eax,Y
> sub eax,[ebx].TView.Origin.Y
> jl @@3
> cmp eax,[ebx].TView.Size.Y
> jg @@1
> mov ax,0005h
> jl @@4
> mov ax,0A03h
> jmp @@4
> @@3:
> inc eax
> jne @@1
> mov ax,0A06h
> @@4:
> mov esi,[ebx].TView.Origin.X
> mov edi,[ebx].TView.Size.X
> add edi,esi
> cmp esi,1
> jg @@5
> xor esi,esi
> inc esi
> @@5:
> cmp edi,edx
> jl @@6
> mov edi,edx
> @@6:
> cmp esi,edi
> jge @@1
> or Byte Ptr FrameMask[esi-1],AL
> xor al,ah
> or Byte Ptr FrameMask[edi],AL
> test ah,ah
> jz @@1
> mov ecx,edi
> sub ecx,esi
> @@8:
> or Byte Ptr FrameMask[esi],ah
> inc esi
> loop @@8
> jmp @@1
> @@10:
> inc edx
> mov ah,Color
> mov ebx,OFFSET FrameChars
> mov ecx,edx
> lea esi,FrameMask
> mov edi,FrameBuf
> @@11:
> lodsb
> xlat
> stosw
> loop @@11
2130c2158
< else if Longint(Owner^.Size) = Longint(Max) then
> else if (Owner^.Size.X = Max.X) and (Owner^.Size.Y = Max.Y) then
2306c2334
< GetPos := LongDiv(LongMul(Value - Min, GetSize - 3) + R shr 1, R) + 1;
> GetPos := ((Value - Min) * (GetSize - 3) + R shr 1) div R + 1;
2388c2416
< SetValue(LongDiv(LongMul(P - 1, Max - Min) + S shr 1, S) + Min);
> SetValue(((P - 1) * (Max - Min) + S shr 1) div S + Min);
2900c2928
< EventMask := $FFFF;
> EventMask := $FFFFFFFF;
2909a2938
> SaveESP: Word;
2917,2929c2946,2956
< asm
> asm {$SAVES ebx,edx,esi}
> mov SaveESP,esp
> mov ecx,Count
> shl ecx,2
> sub esp,ecx
> mov FixupList,esp
> mov edi,esp
> xor eax,eax
> shr ecx,2
> cld
> rep stosd
2952a2980
> asm mov esp,SaveESP end;
2977c3005
< function TGroup.At(Index: Integer): PView; assembler;
> function TGroup.At(Index: Integer): PView; assembler; {$USES None} {$FRAME-}
2979,2985c3007,3012
< LES DI,Self
> mov eax,Self
> mov eax,[eax].TGroup.Last
> mov ecx,Index
> @@1:
> mov eax,[eax].TView.Next
> loop @@1
2990c3017
< procedure DoAwaken(P: PView); far;
> procedure DoAwaken(P: PView);
3003c3030
< procedure DoCalcChange(P: PView); far;
> procedure DoCalcChange(P: PView);
3014c3041
< if Longint(D) = 0 then
> if (D.X or D.Y) = 0 then
3034c3061
< procedure AddSubviewDataSize(P: PView); far;
> procedure AddSubviewDataSize(P: PView);
3152c3179
< function Matches(P: PView): Boolean; far;
> function Matches(P: PView): Boolean;
3162c3189
< function TGroup.FirstThat(P: Pointer): PView; assembler;
> function TGroup.FirstThat(P: Pointer): PView; assembler; {$USES None} {$FRAME-}
3166,3193c3193,3210
< LES DI,Self
> mov eax,Self
> mov eax,[eax].TGroup.Last
> test eax,eax
> jz @@2
> mov ALast,eax
> @@1:
> mov ecx,P
> mov eax,[eax].TView.Next
> push eax
> push eax {[1]:Pointer = PView }
> Call ecx
> test al,al
> pop eax
> jnz @@2
> cmp eax,ALast
> jne @@1
> xor eax,eax
> @@2:
3221c3238
< procedure TGroup.ForEach(P: Pointer); assembler;
> procedure TGroup.ForEach(P: Pointer); assembler; {$USES ebx} {$FRAME-}
3225,3249c3242,3259
< LES DI,Self
> mov ecx,Self
> mov ecx,[ecx].TGroup.Last
> jecxz @@4
> mov ebx,P
> mov ALast,ecx
> mov ecx,[ecx].TView.Next
> @@1:
> cmp ecx,ALast
> je @@3
> push [ecx].TView.Next
> push ecx
> Call ebx
> pop ecx
> jmp @@1
> @@3:
> push ecx
> Call ebx
> @@4:
3258,3259c3268
< { Allocate a group buffer if the group is exposed, buffered, and
> { Allocate a group buffer if the group is exposed and buffered }
3261c3270
< procedure TGroup.GetBuffer; assembler;
> procedure TGroup.GetBuffer; assembler; {$USES None} {$FRAME-}
3263,3282c3272,3289
< LES DI,Self
> mov ecx,Self
> test [ecx].State,sfExposed
> jz @@1
> test [ecx].Options,ofBuffered
> jz @@1
> cmp [ecx].Buffer,0
> jnz @@1
> mov eax,[ecx].TView.Size.X
> mul [ecx].TView.Size.Y
> jo @@1
> shl eax,1
> jc @@1
> js @@1
> lea ecx,[ecx].TView.Buffer
> push ecx { [1]:Pointer = @ of the buffer@ }
> push eax { [2]:Pointer = Buffer Size }
> Call NewCache
> @@1:
3327c3334
< procedure DoHandleEvent(P: PView); far;
> procedure DoHandleEvent(P: PView);
3338c3345
< function ContainsMouse(P: PView): Boolean; far;
> function ContainsMouse(P: PView): Boolean;
3363c3370
< function TGroup.IndexOf(P: PView): Integer; assembler;
> function TGroup.IndexOf(P: PView): Integer; assembler; {$USES None} {$FRAME-}
3365,3385c3372,3386
< LES DI,Self
> mov ecx,Self
> mov ecx,[ecx].TGroup.Last
> jecxz @@2
> mov edx,ecx
> xor eax,eax
> @@1:
> inc eax
> mov ecx,[ecx].TView.Next
> cmp ecx,P
> je @@3
> cmp ecx,edx
> jne @@1
> @@2:
> xor eax,eax
> @@3:
3451c3452
< procedure TGroup.RemoveView(P: PView); assembler;
> procedure TGroup.RemoveView(P: PView); assembler; {$USES edi} {$FRAME+}
3453,3498c3454,3479
< PUSH DS
> mov edx,Self
> mov edi,P
> mov edx,[edx].TGroup.Last
> test edx,edx
> jz @@4
> mov eax,edx
> @@1:
> mov ecx,[edx].TView.Next
> cmp ecx,edi
> je @@2
> cmp ecx,eax
> je @@4
> mov edx,ecx
> jmp @@1
> @@2:
> mov ecx,[edi].TView.Next
> mov [edx].TView.Next,ecx
> cmp eax,edi
> jne @@4
> cmp ecx,edi
> jne @@3
> xor edx,edx
> @@3:
> mov edi,Self
> mov [edi].TView.Last,edx
> @@4:
3566c3547
< procedure DoSetState(P: PView); far;
> procedure DoSetState(P: PView);
3571c3552
< procedure DoExpose(P: PView); far;
> procedure DoExpose(P: PView);
3600c3581
< procedure DoPut(P: PView); far;
> procedure DoPut(P: PView);
3627c3608
< function IsInvalid(P: PView): Boolean; far;
> function IsInvalid(P: PView): Boolean;
3820c3801
< if Longint(Size) <> Longint(Max) then
> if (Size.X <> Max.X) or (Size.Y <> Max.Y) then
3823c3804,3805
< Longint(R.A) := 0;
> R.A.X := 0;
> R.A.Y := 0;